1 | unit FormMain;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus, Math,
|
---|
7 | ActnList, ExtCtrls, StdCtrls, Game, PersistentForm, ApplicationInfo,
|
---|
8 | LCLType, Syncobjs, DateUtils, FormEx;
|
---|
9 |
|
---|
10 | type
|
---|
11 | TFormMain = class;
|
---|
12 |
|
---|
13 | { TMoveThread }
|
---|
14 |
|
---|
15 | TMoveThread = class(TThread)
|
---|
16 | FormMain: TFormMain;
|
---|
17 | procedure Execute; override;
|
---|
18 | end;
|
---|
19 |
|
---|
20 | { TFormMain }
|
---|
21 |
|
---|
22 | TFormMain = class(TFormEx)
|
---|
23 | MainMenu1: TMainMenu;
|
---|
24 | MenuItem1: TMenuItem;
|
---|
25 | MenuItem2: TMenuItem;
|
---|
26 | MenuItem3: TMenuItem;
|
---|
27 | MenuItem4: TMenuItem;
|
---|
28 | MenuItem5: TMenuItem;
|
---|
29 | MenuItem6: TMenuItem;
|
---|
30 | MenuItemFullScreen: TMenuItem;
|
---|
31 | MenuItemMovesHistory: TMenuItem;
|
---|
32 | MenuItemTools: TMenuItem;
|
---|
33 | MenuItemNew: TMenuItem;
|
---|
34 | MenuItemExit: TMenuItem;
|
---|
35 | MenuItemHelp: TMenuItem;
|
---|
36 | MenuItemAbout: TMenuItem;
|
---|
37 | MenuItemGame: TMenuItem;
|
---|
38 | TimerDraw: TTimer;
|
---|
39 | procedure FormActivate(Sender: TObject);
|
---|
40 | procedure FormCreate(Sender: TObject);
|
---|
41 | procedure FormDestroy(Sender: TObject);
|
---|
42 | procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
---|
43 | procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
44 | Shift: TShiftState; X, Y: Integer);
|
---|
45 | procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
---|
46 | procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
47 | Shift: TShiftState; X, Y: Integer);
|
---|
48 | procedure FormPaint(Sender: TObject);
|
---|
49 | procedure FormShow(Sender: TObject);
|
---|
50 | procedure MenuItemFullScreenClick(Sender: TObject);
|
---|
51 | procedure TimerDrawTimer(Sender: TObject);
|
---|
52 | procedure EraseBackground(DC: HDC); override;
|
---|
53 | private
|
---|
54 | DrawDuration: TDateTime;
|
---|
55 | MouseStart: TPoint;
|
---|
56 | MouseDown: Boolean;
|
---|
57 | RedrawPending: Boolean;
|
---|
58 | MoveBuffer: array of TMoveDirection;
|
---|
59 | MoveBufferLock: TCriticalSection;
|
---|
60 | FullScreen: Boolean;
|
---|
61 | procedure AddToMoveBuffer(Direction: TMoveDirection);
|
---|
62 | procedure ProcessMoveBuffer;
|
---|
63 | procedure ToggleFullscreen;
|
---|
64 | public
|
---|
65 | MoveThread: TMoveThread;
|
---|
66 | procedure Redraw;
|
---|
67 | procedure UpdateInterface;
|
---|
68 | end;
|
---|
69 |
|
---|
70 | var
|
---|
71 | FormMain: TFormMain;
|
---|
72 |
|
---|
73 |
|
---|
74 | implementation
|
---|
75 |
|
---|
76 | {$R *.lfm}
|
---|
77 |
|
---|
78 | uses
|
---|
79 | Core;
|
---|
80 |
|
---|
81 | { TMoveThread }
|
---|
82 |
|
---|
83 | procedure TMoveThread.Execute;
|
---|
84 | begin
|
---|
85 | while not Terminated do begin
|
---|
86 | FormMain.ProcessMoveBuffer;
|
---|
87 | Sleep(10);
|
---|
88 | end;
|
---|
89 | end;
|
---|
90 |
|
---|
91 | { TFormMain }
|
---|
92 |
|
---|
93 | procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
---|
94 | const
|
---|
95 | KeyLeft = 37;
|
---|
96 | KeyUp = 38;
|
---|
97 | KeyRight = 39;
|
---|
98 | KeyDown = 40;
|
---|
99 | KeyNumPadLeft = 100;
|
---|
100 | KeyNumPadUp = 104;
|
---|
101 | KeyNumPadRight = 102;
|
---|
102 | KeyNumPadDown = 98;
|
---|
103 | begin
|
---|
104 | if Core.Core.Game.Running then begin
|
---|
105 | case Key of
|
---|
106 | KeyLeft, KeyNumPadLeft: AddToMoveBuffer(drLeft);
|
---|
107 | KeyUp, KeyNumPadUp: AddToMoveBuffer(drUp);
|
---|
108 | KeyRight, KeyNumPadRight: AddToMoveBuffer(drRight);
|
---|
109 | KeyDown, KeyNumPadDown: AddToMoveBuffer(drDown);
|
---|
110 | end;
|
---|
111 | //ProcessMoveBuffer;
|
---|
112 | end;
|
---|
113 | end;
|
---|
114 |
|
---|
115 | procedure TFormMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
116 | Shift: TShiftState; X, Y: Integer);
|
---|
117 | begin
|
---|
118 | MouseStart := Point(X, Y);
|
---|
119 | MouseDown := True;
|
---|
120 | end;
|
---|
121 |
|
---|
122 | function AngleOfLine(const P1, P2: TPoint): Double;
|
---|
123 | begin
|
---|
124 | if P2.X = P1.X then
|
---|
125 | if P2.Y > P1.Y then
|
---|
126 | Result := 90
|
---|
127 | else
|
---|
128 | Result := 270
|
---|
129 | else
|
---|
130 | Result := RadToDeg(ArcTan2(P2.Y - P1.Y, P2.X - P1.X));
|
---|
131 | if Result < 0 then
|
---|
132 | Result := Result + 360;
|
---|
133 | end;
|
---|
134 |
|
---|
135 | procedure TFormMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
|
---|
136 | Y: Integer);
|
---|
137 | var
|
---|
138 | D: Real;
|
---|
139 | Angle: Real;
|
---|
140 | begin
|
---|
141 | if MouseDown then begin;
|
---|
142 | D := MouseStart.Distance(Point(X, Y));
|
---|
143 | if D > ScaleX(100, 96) then begin
|
---|
144 | MouseDown := False;
|
---|
145 | Angle := AngleOfLine(MouseStart, Point(X, Y));
|
---|
146 | if (Angle > 315) or (Angle <= 45) then AddToMoveBuffer(drRight)
|
---|
147 | else if (Angle > 45) and (Angle <= 135) then AddToMoveBuffer(drDown)
|
---|
148 | else if (Angle > 135) and (Angle <= 225) then AddToMoveBuffer(drLeft)
|
---|
149 | else if (Angle > 225) and (Angle <= 315) then AddToMoveBuffer(drUp);
|
---|
150 | //ProcessMoveBuffer;
|
---|
151 | end;
|
---|
152 | end;
|
---|
153 | end;
|
---|
154 |
|
---|
155 | procedure TFormMain.FormMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
156 | Shift: TShiftState; X, Y: Integer);
|
---|
157 | begin
|
---|
158 | MouseDown := False;
|
---|
159 | end;
|
---|
160 |
|
---|
161 | procedure TFormMain.FormPaint(Sender: TObject);
|
---|
162 | var
|
---|
163 | TimeStart: TDateTime;
|
---|
164 | begin
|
---|
165 | {$IFDEF DEBUG}
|
---|
166 | TimeStart := Now;
|
---|
167 | {$ENDIF}
|
---|
168 | Core.Core.Game.Render(Canvas, Point(Width, Height - MainMenu1.Height));
|
---|
169 | {$IFDEF DEBUG}
|
---|
170 | DrawDuration := Now - TimeStart;
|
---|
171 | {$ENDIF}
|
---|
172 | end;
|
---|
173 |
|
---|
174 | procedure TFormMain.FormActivate(Sender: TObject);
|
---|
175 | begin
|
---|
176 | FullScreen := Core.Core.PersistentForm1.FormFullScreen;
|
---|
177 | end;
|
---|
178 |
|
---|
179 | procedure TFormMain.FormCreate(Sender: TObject);
|
---|
180 | begin
|
---|
181 | MoveBufferLock := TCriticalSection.Create;
|
---|
182 | MoveThread := TMoveThread.Create(True);
|
---|
183 | MoveThread.FormMain := Self;
|
---|
184 | MoveThread.FreeOnTerminate := False;
|
---|
185 | MoveThread.Start;
|
---|
186 | ControlStyle := ControlStyle + [csOpaque];
|
---|
187 | end;
|
---|
188 |
|
---|
189 | procedure TFormMain.FormDestroy(Sender: TObject);
|
---|
190 | begin
|
---|
191 | FreeAndNil(MoveThread);
|
---|
192 | FreeAndNil(MoveBufferLock);
|
---|
193 | end;
|
---|
194 |
|
---|
195 | procedure TFormMain.FormShow(Sender: TObject);
|
---|
196 | begin
|
---|
197 | UpdateInterface;
|
---|
198 | if Core.Core.Game.Board.GetEmptyTilesCount > Core.Core.Game.Board.Size.X *
|
---|
199 | Core.Core.Game.Board.Size.Y - InitialTileCount then
|
---|
200 | Core.Core.Game.New;
|
---|
201 | end;
|
---|
202 |
|
---|
203 | procedure TFormMain.MenuItemFullScreenClick(Sender: TObject);
|
---|
204 | begin
|
---|
205 | ToggleFullscreen;
|
---|
206 | end;
|
---|
207 |
|
---|
208 | procedure TFormMain.TimerDrawTimer(Sender: TObject);
|
---|
209 | begin
|
---|
210 | if RedrawPending then begin
|
---|
211 | RedrawPending := False;
|
---|
212 | Repaint;
|
---|
213 | {$IFDEF DEBUG}
|
---|
214 | //Caption := FloatToStr(Round(DrawDuration / OneMillisecond));
|
---|
215 | {$ENDIF}
|
---|
216 | end;
|
---|
217 | end;
|
---|
218 |
|
---|
219 | procedure TFormMain.EraseBackground(DC: HDC);
|
---|
220 | begin
|
---|
221 | // Do nothing
|
---|
222 | end;
|
---|
223 |
|
---|
224 | procedure TFormMain.AddToMoveBuffer(Direction: TMoveDirection);
|
---|
225 | begin
|
---|
226 | MoveBufferLock.Acquire;
|
---|
227 | try
|
---|
228 | SetLength(MoveBuffer, Length(MoveBuffer) + 1);
|
---|
229 | MoveBuffer[Length(MoveBuffer) - 1] := Direction;
|
---|
230 | finally
|
---|
231 | MoveBufferLock.Release;
|
---|
232 | end;
|
---|
233 | end;
|
---|
234 |
|
---|
235 | procedure TFormMain.ProcessMoveBuffer;
|
---|
236 | begin
|
---|
237 | if not Core.Core.Game.Moving then begin
|
---|
238 | MoveBufferLock.Acquire;
|
---|
239 | while Length(MoveBuffer) > 0 do begin
|
---|
240 | MoveBufferLock.Release;
|
---|
241 | Core.Core.Game.MoveAllAndUpdate(MoveBuffer[0], Core.Core.Game.AnimationDuration > 0);
|
---|
242 | MoveBufferLock.Acquire;
|
---|
243 | if Length(MoveBuffer) > 1 then
|
---|
244 | Move(MoveBuffer[1], MoveBuffer[0], (Length(MoveBuffer) - 1) * SizeOf(TMoveDirection));
|
---|
245 | if Length(MoveBuffer) > 0 then
|
---|
246 | SetLength(MoveBuffer, Length(MoveBuffer) - 1);
|
---|
247 | end;
|
---|
248 | MoveBufferLock.Release;
|
---|
249 | end;
|
---|
250 | end;
|
---|
251 |
|
---|
252 | procedure TFormMain.ToggleFullscreen;
|
---|
253 | begin
|
---|
254 | FullScreen := not FullScreen;
|
---|
255 | Core.Core.PersistentForm1.Save(Self);
|
---|
256 | Core.Core.PersistentForm1.SetFullScreen(FormMain.FullScreen);
|
---|
257 | UpdateInterface;
|
---|
258 | end;
|
---|
259 |
|
---|
260 | procedure TFormMain.Redraw;
|
---|
261 | begin
|
---|
262 | RedrawPending := True;
|
---|
263 | end;
|
---|
264 |
|
---|
265 | procedure TFormMain.UpdateInterface;
|
---|
266 | var
|
---|
267 | I: Integer;
|
---|
268 | ToolsVisible: Boolean;
|
---|
269 | begin
|
---|
270 | MenuItemFullScreen.Checked := FullScreen;
|
---|
271 | MenuItemMovesHistory.Visible := Core.Core.Game.RecordHistory;
|
---|
272 | ToolsVisible := False;
|
---|
273 | for I := 0 to MenuItemTools.Count - 1 do
|
---|
274 | if MenuItemTools.Items[I].Visible then begin
|
---|
275 | ToolsVisible := True;
|
---|
276 | Break;
|
---|
277 | end;
|
---|
278 | MenuItemTools.Visible := ToolsVisible;
|
---|
279 | end;
|
---|
280 |
|
---|
281 | end.
|
---|
282 |
|
---|