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