1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2009-2016. 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%%%-------------------------------------------------------------------
20%%% File    : sud_board.erl
21%%% Author  :  <dgud@erix.ericsson.se>
22%%% Description : Manages the gui board
23%%%
24%%% Created :  9 Jan 2008 by  <dgud@erix.ericsson.se>
25%%%-------------------------------------------------------------------
26-module(sudoku_board).
27
28-export([new/1, setup_board/2, clear_board/1, left/1,
29	 get_board_data/1,set_board_data/2,
30	 set_butt/3, butt_correct/3,
31	 get_state/1, redraw/3,
32	 %% Callbacks
33	 init/1, handle_sync_event/3,
34	 handle_event/2, handle_info/2, handle_call/3, handle_cast/2,
35	 code_change/3, terminate/2]).
36
37-include("sudoku.hrl").
38
39-record(state, {win, parent, board=[], pen, fonts=[]}).
40-record(sq, {key,val,correct=true,given=false}).
41-define(BRD,10).
42-define(ARC_R, 10).
43
44-behaviour(wx_object).
45
46%% API
47new(ParentObj) ->
48    wx_object:start_link(?MODULE, [ParentObj, self()], []).
49
50setup_board(Board, Init) ->
51    wx_object:call(Board, {setup_board, Init}).
52
53clear_board(Board) ->
54    wx_object:call(Board, clear_board).
55
56butt_correct(Board, Key, Correct) ->
57    wx_object:call(Board, {butt_correct, Key, Correct}).
58
59set_butt(Board, Indx, Val) when is_integer(Indx) ->
60    {R,C,_} = sudoku_game:rcm(Indx),
61    set_butt(Board, {R,C}, Val);
62set_butt(Board, Id, Val) ->
63    wx_object:call(Board, {set_butt, Id, Val}).
64
65left(Board) ->
66    wx_object:call(Board, left).
67
68get_board_data(Board) ->
69    wx_object:call(Board, get_board_data).
70set_board_data(Board, List) ->
71    wx_object:call(Board, {set_board_data, List}).
72
73get_state(Board) ->
74    wx_object:call(Board, get_state).
75
76
77%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
78
79init([ParentObj, ParentPid]) ->
80    Win = wxPanel:new(ParentObj, [{style, ?wxFULL_REPAINT_ON_RESIZE}]),
81    wxWindow:setFocus(Win), %% Get keyboard focus
82    wxWindow:setSizeHints(Win, {250,250}),
83    wxWindow:connect(Win, paint,  [callback]),
84    wxWindow:connect(Win, size,  []),
85    wxWindow:connect(Win, erase_background, []),
86    wxWindow:connect(Win, key_up, [{skip, true}]),
87    wxWindow:connect(Win, left_down, [{skip, true}]),
88    wxWindow:connect(Win, enter_window, [{skip, true}]),
89
90    %% Init pens and fonts
91    Pen = wxPen:new({0,0,0}, [{width, 3}]),
92    Fs0  = [{Sz,wxFont:new(Sz, ?wxSWISS, ?wxNORMAL, ?wxNORMAL,[])} ||
93	       Sz <- [8,9,10,11,12,13,14,16,18,20,22,24,26,28,30,34,38,42,44,46]],
94    TestDC  = wxMemoryDC:new(),
95    Bitmap = wxBitmap:new(256,256),
96    wxMemoryDC:selectObject(TestDC, Bitmap),
97    true = wxDC:isOk(TestDC),
98    CW = fun({Sz,Font},Acc) ->
99		 case wxFont:ok(Font) of
100		     true ->
101			 wxDC:setFont(TestDC, Font),
102			 CH = wxDC:getCharHeight(TestDC),
103			 [{CH,Sz,Font} | Acc];
104		     false ->
105			 Acc
106		 end
107	 end,
108    Fs = lists:foldl(CW, [], Fs0),
109    wxMemoryDC:destroy(TestDC),
110    {Win, #state{win=Win, board=[], pen=Pen, fonts=Fs,parent=ParentPid}}.
111
112handle_sync_event(#wx{event=#wxPaint{}}, _Obj, State = #state{win=Win}) ->
113    %% io:format("EPaint~n",[]),
114    Size = wxWindow:getSize(Win),
115    DC = wxPaintDC:new(Win),
116    wxDC:destroyClippingRegion(DC),
117    redraw(DC,Size,State),
118    wxPaintDC:destroy(DC),
119    %%io:format("...EPaint~n",[]),
120    ok.
121
122handle_event(#wx{event=#wxMouse{type=enter_window}}, State = #state{win=Win}) ->
123    wxWindow:setFocus(Win), %% Get keyboard focus
124    {noreply,State};
125handle_event(#wx{event=#wxKey{keyCode=KeyC}},
126	     S = #state{parent=Pid, win=Win}) ->
127    Val = if KeyC > 47, KeyC < 58 -> KeyC - $0;
128	     KeyC > 325, KeyC < 336 -> KeyC - 326; %% NUM LOCK
129	     true -> 0
130	  end,
131    Global = wx_misc:getMousePosition(),
132    {CX,CY} = wxWindow:screenToClient(Win, Global),
133    case get_butt(CX,CY,S) of
134	error -> ignore;
135	Id -> Pid ! {set_val,Id,Val}
136    end,
137    {noreply, S};
138handle_event(#wx{event=#wxMouse{type=left_down,x=X,y=Y}},
139	     S = #state{parent=Gui, win=F}) ->
140    Id = get_butt(X,Y,S),
141    case Id of
142	error -> ignore;
143	_ -> create_popup_menu(Gui,Id,X,Y,F)
144    end,
145    {noreply, S};
146handle_event(#wx{event=#wxSize{}}, State) ->
147    redraw(State),
148    {noreply,State};
149handle_event(_Ev, State) ->
150    {noreply,State}.
151
152%%%%%%%%%%%%%%%%%%%
153
154handle_call({set_butt, Key, 0},_From,S0=#state{board=B0}) ->  %% Reset
155    B = lists:keydelete(Key,2,B0),
156    S = S0#state{board=B},
157    redraw(S),
158    {reply, ok, S};
159
160handle_call({set_butt, Key, Val},_From,S0=#state{board=B0}) ->
161    case lists:keysearch(Key,2,B0) of
162	{value, _} ->
163	    B = lists:keyreplace(Key, 2, B0, #sq{key=Key,val=Val});
164	false ->
165	    B = [#sq{key=Key, val=Val}|B0]
166    end,
167    S = S0#state{board=B},
168    redraw(S),
169    {reply, ok, S};
170
171handle_call({butt_correct, Key, Correct},_From, S0=#state{board=B0}) ->
172    case lists:keysearch(Key,2,B0) of
173	{value, Butt} ->
174	    B = lists:keyreplace(Key, 2, B0, Butt#sq{key=Key,correct=Correct});
175	false ->
176	    B = B0
177    end,
178    S = S0#state{board=B},
179    redraw(S),
180    {reply, ok, S};
181
182handle_call({setup_board, Init},_From, State) ->
183    B = [#sq{given=true, correct=true, key=Key, val=Val} || {Key,Val} <- Init],
184    S = State#state{board=B},
185    redraw(S),
186    {reply, ok, S};
187
188handle_call(clear_board,_From, State = #state{board=B0}) ->
189    B = [Butt || Butt = #sq{given=true} <- B0],
190    S = State#state{board=B},
191    redraw(S),
192    Given = [{Key, Val} || #sq{key=Key,val=Val,given=true} <- B],
193    {reply, Given, S};
194handle_call(get_board_data,_From, S=#state{board=B0}) ->
195    {reply, B0, S};
196handle_call({set_board_data, B},_From, S0) ->
197    S = S0#state{board=B},
198    redraw(S),
199    G1 = [{Key, Val} || #sq{key=Key,val=Val,given=true} <- B],
200    G2 = [{Key, Val} || #sq{key=Key,val=Val,given=false,correct=true} <- B],
201    G3 = [{Key, Val} || #sq{key=Key,val=Val,given=false,correct=false} <- B],
202    {reply, G1 ++ G2 ++ G3, S};
203handle_call(left,_From, S = #state{board=B}) ->
204    Res = 81 - length([ok || #sq{correct=C} <- B, C /= false]),
205    {reply, Res, S};
206handle_call(get_state, _From, S) ->
207    {reply, {ok,S}, S}.
208
209handle_cast(Msg, State) ->
210    io:format("Got cast ~p~n",[Msg]),
211    {noreply,State}.
212
213code_change(_, _, State) ->
214    {stop, not_yet_implemented, State}.
215
216handle_info(Msg, State) ->
217    {stop, {info, Msg}, State}.
218
219terminate(_Reason, _State) ->
220    normal.
221
222%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
223
224
225%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
226
227get_butt(X, Y, #state{win=Win}) ->
228    {W0,H0} = wxWindow:getSize(Win),
229    BoxSz = getGeomSz(W0,H0),
230    %%    io:format("~p ~p ~p ~p~n", [{X,Y}, {W0,H0}, BoxSz, calc_pos(X-?BRD,Y-?BRD, BoxSz)]),
231    case calc_pos(X-?BRD,Y-?BRD, BoxSz) of
232	Pos = {R,C} when 0 < R, R < 10, 0 < C, C < 10 -> Pos;
233	_ -> error
234    end.
235
236calc_pos(X,Y, BoxSz) ->
237    {1+(Y*3 div BoxSz), 1+(X*3 div BoxSz)}.
238
239redraw(S = #state{win=Win}) ->
240    DC0  = wxClientDC:new(Win),
241    DC   = wxBufferedDC:new(DC0),
242    Size = wxWindow:getSize(Win),
243    redraw(DC, Size, S),
244    wxBufferedDC:destroy(DC),
245    wxClientDC:destroy(DC0),
246    ok.
247
248redraw(DC, Size, S) ->
249    wx:batch(fun() ->
250		     wxDC:setBackground(DC, ?wxWHITE_BRUSH),
251		     wxDC:clear(DC),
252		     BoxSz = draw_board(DC,Size,S),
253		     F = sel_font(BoxSz div 3,S#state.fonts),
254		     [draw_number(DC,F,BoxSz,Sq) || Sq <- S#state.board]
255	     end).
256
257sel_font(_BS,[{_H,_Sz,F}]) ->
258    %%   io:format("Font sz ~p height ~p in BS ~p~n",[_Sz,_H, _BS]),
259    F;
260sel_font(BS,[{H,_Sz,F}|_]) when BS > (H + 6) ->
261    %%   io:format("Font sz ~p height ~p in BS ~p~n",[_Sz,H, BS]),
262    F;
263sel_font(BS,[_|Fs]) ->
264    sel_font(BS,Fs).
265
266draw_number(DC,F,Sz,#sq{key={R,C},val=Num,given=Bold,correct=Correct}) ->
267    {X,Y} = get_coords(Sz,R-1,C-1),
268    TBox = Sz div 3,
269    if Bold ->
270	    wxFont:setWeight(F,?wxBOLD),
271	    wxDC:setTextForeground(DC,{0,0,0});
272       Correct =:= false ->
273	    wxFont:setWeight(F,?wxNORMAL),
274	    wxDC:setTextForeground(DC,{255,40,40,255});
275       true ->
276	    wxFont:setWeight(F,?wxNORMAL),
277	    wxDC:setTextForeground(DC,{50,50,100,255})
278    end,
279    wxDC:setFont(DC,F),
280    CH = (TBox - wxDC:getCharHeight(DC)) div 2,
281    CW = (TBox - wxDC:getCharWidth(DC)) div 2,
282    wxDC:drawText(DC, integer_to_list(Num), {X+CW,Y+CH+1}),
283    ok.
284
285get_coords(Sz,R,C) ->
286    TBox = Sz div 3,
287    R1 = R div 3,
288    R2 = R rem 3,
289    C1 = C div 3,
290    C2 = C rem 3,
291    {?BRD + C1*Sz + C2*TBox,
292     ?BRD + R1*Sz + R2*TBox}.
293
294draw_board(DC,{W0,H0},#state{pen=Pen}) ->
295    BoxSz = getGeomSz(W0,H0),
296    BS = ?BRD+3*BoxSz,
297
298    wxPen:setWidth(Pen, 3),
299    wxPen:setColour(Pen, {0,0,0}),
300    wxDC:setPen(DC,Pen),
301
302    wxDC:drawRoundedRectangle(DC, {?BRD,?BRD,3*BoxSz+1,3*BoxSz+1},
303			      float(?ARC_R)),
304    %% Testing DrawLines
305    wxDC:drawLines(DC, [{?BRD+BoxSz, ?BRD}, {?BRD+BoxSz, BS}]),
306    wxDC:drawLine(DC, {?BRD+BoxSz*2, ?BRD}, {?BRD+BoxSz*2, BS}),
307    wxDC:drawLine(DC, {?BRD, ?BRD+BoxSz}, {BS, ?BRD+BoxSz}),
308    wxDC:drawLine(DC, {?BRD, ?BRD+BoxSz*2}, {BS, ?BRD+BoxSz*2}),
309
310    %% Draw inside lines
311    wxPen:setWidth(Pen, 1),
312    wxDC:setPen(DC,Pen),
313    TBox = BoxSz div 3,
314    wxDC:drawLine(DC, {?BRD+TBox, ?BRD}, {?BRD+TBox, BS}),
315    wxDC:drawLine(DC, {?BRD+TBox*2, ?BRD}, {?BRD+TBox*2, BS}),
316    wxDC:drawLine(DC, {?BRD+TBox+BoxSz, ?BRD}, {?BRD+TBox+BoxSz, BS}),
317    wxDC:drawLine(DC, {?BRD+TBox*2+BoxSz, ?BRD}, {?BRD+TBox*2+BoxSz, BS}),
318    wxDC:drawLine(DC, {?BRD+TBox+BoxSz*2, ?BRD}, {?BRD+TBox+BoxSz*2, BS}),
319    wxDC:drawLine(DC, {?BRD+TBox*2+BoxSz*2, ?BRD}, {?BRD+TBox*2+BoxSz*2, BS}),
320    %% Vert
321    wxDC:drawLine(DC, {?BRD, ?BRD+TBox}, {BS, ?BRD+TBox}),
322    wxDC:drawLine(DC, {?BRD, ?BRD+TBox*2}, {BS, ?BRD+TBox*2}),
323    wxDC:drawLine(DC, {?BRD, ?BRD+TBox+BoxSz}, {BS, ?BRD+TBox+BoxSz}),
324    wxDC:drawLine(DC, {?BRD, ?BRD+TBox*2+BoxSz}, {BS, ?BRD+TBox*2+BoxSz}),
325    wxDC:drawLine(DC, {?BRD, ?BRD+TBox+BoxSz*2}, {BS, ?BRD+TBox+BoxSz*2}),
326    wxDC:drawLine(DC, {?BRD, ?BRD+TBox*2+BoxSz*2}, {BS, ?BRD+TBox*2+BoxSz*2}),
327    BoxSz.
328
329getGeomSz(W,H) ->
330    Small = if W < H -> W; true -> H end,
331    (Small - 2*?BRD) div 3.
332
333
334%% popupmenu
335
336create_popup_menu(GFX,Butt,X,Y,Frame) ->
337    Port = wx:get_env(),
338    spawn_link(fun() -> create_popup_menu1(GFX,Butt,Port,X,Y,Frame) end).
339
340create_popup_menu1(GFX,Butt,Port,X,Y,Frame) ->
341    wx:set_env(Port),
342    PopupMenu = wxMenu:new(),
343    create_popup_menu2(1, PopupMenu),
344
345    wxEvtHandler:connect(PopupMenu, command_menu_selected),
346    wxWindow:popupMenu(Frame,PopupMenu,X,Y),
347    receive
348	#wx{event=#wxCommand{type=command_menu_selected},id=10} ->
349	    GFX ! {set_val,Butt,0};
350	#wx{event=#wxCommand{type=command_menu_selected},id=What} ->
351	    GFX ! {set_val,Butt,What}
352    end.
353
354create_popup_menu2(N,PP) when N > 9 ->
355    wxMenu:append(PP, 10, "Clear");
356create_popup_menu2(N,PP) ->
357    wxMenu:append(PP, N,integer_to_list(N)),
358    create_popup_menu2(N+1,PP).
359
360