1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2011-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19-module(cdv_multi_wx).
20
21-behaviour(wx_object).
22
23-export([start_link/2]).
24%% wx_object callbacks
25-export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3,
26	 handle_event/2, handle_cast/2]).
27
28-include_lib("wx/include/wx.hrl").
29-include("observer_defs.hrl").
30
31%% Records
32-record(state,
33	{main_panel,
34	 main_sizer,
35	 menu,
36	 menu_sizer,
37	 callback,
38	 pages,
39	 dyn_panel,
40	 dyn_sizer,
41	 dyn_page
42	}).
43
44start_link(Notebook, Info) ->
45    wx_object:start_link(?MODULE, [Notebook, Info], []).
46
47%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
48
49init([Notebook, Callback]) when is_atom(Callback) ->
50    Pages = Callback:get_info(),
51    {MainPanel,State0} = init([Notebook, Pages]),
52    {MainPanel,State0#state{callback=Callback}};
53init([Notebook, Pages]) ->
54    MainPanel = wxPanel:new(Notebook),
55    Sizer = wxBoxSizer:new(?wxHORIZONTAL),
56    LeftMenuSizer = wxStaticBoxSizer:new(?wxVERTICAL,MainPanel,
57					 [{label,"Please select"}]),
58    LeftMenu = wxListBox:new(MainPanel,?wxID_ANY,
59			     [{style,?wxLB_SINGLE},
60			      {choices,[T || {T,_,_} <- Pages]}]),
61    wxListBox:setSelection(LeftMenu,0),
62    wxListBox:connect(LeftMenu, command_listbox_selected),
63    wxSizer:add(LeftMenuSizer,LeftMenu,[{flag,?wxEXPAND},{proportion,2}]),
64
65    DynPanel  = wxScrolledWindow:new(MainPanel),
66    wxScrolledWindow:enableScrolling(DynPanel,true,true),
67    wxScrolledWindow:setScrollbars(DynPanel,1,1,0,0),
68
69    BorderFlags = ?wxLEFT bor ?wxRIGHT,
70    wxSizer:add(Sizer, LeftMenuSizer,
71		[{flag, ?wxEXPAND bor BorderFlags bor ?wxTOP},
72		 {proportion, 0}, {border, 5}]),
73    wxSizer:add(Sizer, DynPanel, [{flag, ?wxEXPAND bor BorderFlags bor ?wxTOP},
74				  {proportion, 1}, {border, 5}]),
75    wxPanel:setSizer(MainPanel, Sizer),
76
77    State = load_dyn_page(#state{main_panel=MainPanel,
78				 main_sizer=Sizer,
79				 menu=LeftMenu,
80				 menu_sizer=LeftMenuSizer,
81				 pages=Pages,
82				 dyn_panel=DynPanel
83				}),
84    {MainPanel, State}.
85
86%%%%%%%%%%%%%%%%%%%%%%% Callbacks %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
87
88handle_info(active, State) ->
89    NewState =
90	wx:batch(
91	  fun() ->
92		  update_dyn_page(State)
93	  end),
94    {noreply, NewState};
95
96handle_info(Info, State) ->
97    io:format("~p:~p: Unhandled info: ~tp~n", [?MODULE, ?LINE, Info]),
98    {noreply, State}.
99
100terminate(_Reason, _State) ->
101    ok.
102
103code_change(_, _, State) ->
104    {ok, State}.
105
106handle_call(new_dump, _From, State) ->
107    NewState =
108	wx:batch(
109	  fun() ->
110		  update_left_menu(State)
111	  end),
112    {reply, ok, NewState};
113
114handle_call(Msg, _From, State) ->
115    io:format("~p:~p: Unhandled Call ~tp~n",[?MODULE, ?LINE, Msg]),
116    {reply, ok, State}.
117
118handle_cast(Msg, State) ->
119    io:format("~p:~p: Unhandled cast ~tp~n",[?MODULE, ?LINE, Msg]),
120    {noreply, State}.
121
122handle_event(#wx{event=#wxCommand{type=command_listbox_selected,
123				  cmdString=[]}},
124	     State) ->
125    %% For some reason, the listbox sometimes gets an "unselect"
126    %% command like this during termination. Ignore!
127    {noreply, State};
128
129handle_event(#wx{event=#wxCommand{type=command_listbox_selected,
130				  cmdString=_DynName}},
131	     State) ->
132    NewState =
133	wx:batch(fun() ->
134			 update_dyn_page(State)
135		 end),
136    {noreply,NewState};
137
138handle_event(Event, State) ->
139    io:format("~p:~p: Unhandled event ~tp\n", [?MODULE,?LINE,Event]),
140    {noreply, State}.
141
142%%%%%%%%%%%%%%%%%%%%%%% Internal %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
143update_left_menu(#state{main_panel=Panel,
144			callback=Callback,
145			menu=OldMenu,
146			menu_sizer=MenuSizer} = State) ->
147    Pages = Callback:get_info(),
148    wxListBox:disconnect(OldMenu),
149    wxWindow:destroy(OldMenu),
150    NewMenu = wxListBox:new(Panel,?wxID_ANY,
151			    [{style,?wxLB_SINGLE},
152			     {choices,[T || {T,_,_} <- Pages]}]),
153    wxListBox:setSelection(NewMenu,0),
154    wxListBox:connect(NewMenu, command_listbox_selected),
155    wxSizer:add(MenuSizer,NewMenu,[{flag,?wxEXPAND},{proportion,2}]),
156    wxSizer:layout(MenuSizer),
157    State#state{pages=Pages,menu=NewMenu}.
158
159update_dyn_page(#state{dyn_page=undefined} = State) ->
160    load_dyn_page(State);
161update_dyn_page(#state{dyn_page=OldDynPage,
162		       dyn_sizer=OldDynSizer} = State) ->
163    wxSizer:detach(OldDynSizer,OldDynPage),
164    wxWindow:destroy(OldDynPage),
165    load_dyn_page(State).
166
167load_dyn_page(#state{main_sizer=MainSizer,
168		     dyn_panel=DynPanel,
169		     menu=Menu,
170		     pages=Pages} = State) ->
171    %% Freeze and thaw causes a hang (and is not needed) on 2.9 and higher
172    DoFreeze = [?wxMAJOR_VERSION,?wxMINOR_VERSION] < [2,9],
173    DoFreeze andalso wxWindow:freeze(DynPanel),
174    Name = wxListBox:getStringSelection(Menu),
175    {Page,Sizer} = load_dyn_page(DynPanel,Name,Pages),
176    wxSizer:layout(MainSizer),
177    DoFreeze andalso wxWindow:thaw(DynPanel),
178    wx_object:get_pid(Page) ! active,
179    State#state{dyn_page=Page,dyn_sizer=Sizer}.
180
181load_dyn_page(Panel,Name,Pages) ->
182    Sizer = wxStaticBoxSizer:new(?wxVERTICAL, Panel, [{label,Name}]),
183
184    {_,Callback,Info} = lists:keyfind(Name,1,Pages),
185    DynPage = Callback:start_link(Panel,Info),
186
187    wxSizer:add(Sizer,DynPage,[{flag, ?wxEXPAND}, {proportion, 1}]),
188    wxPanel:setSizerAndFit(Panel,Sizer,[{deleteOld,true}]),
189    {DynPage,Sizer}.
190