source: tags/1.3.0/UCore.pas

Last change on this file was 67, checked in by chronos, 4 years ago
File size: 5.8 KB
Line 
1unit UCore;
2
3{$mode delphi}
4
5interface
6
7uses
8 Classes, SysUtils, UTheme, UPersistentForm, UApplicationInfo, UTranslator,
9 URegistry, UGame, ActnList, Forms, Controls, Dialogs;
10
11type
12
13 { TCore }
14
15 TCore = class(TDataModule)
16 AAbout: TAction;
17 AComputer: TAction;
18 AHistory: TAction;
19 AHelp: TAction;
20 AUndo: TAction;
21 ASettings: TAction;
22 ActionList1: TActionList;
23 AExit: TAction;
24 ANew: TAction;
25 ApplicationInfo1: TApplicationInfo;
26 PersistentForm1: TPersistentForm;
27 ThemeManager1: TThemeManager;
28 Translator1: TTranslator;
29 procedure AAboutExecute(Sender: TObject);
30 procedure AComputerExecute(Sender: TObject);
31 procedure AExitExecute(Sender: TObject);
32 procedure AHelpExecute(Sender: TObject);
33 procedure AHistoryExecute(Sender: TObject);
34 procedure ANewExecute(Sender: TObject);
35 procedure ASettingsExecute(Sender: TObject);
36 procedure AUndoExecute(Sender: TObject);
37 procedure DataModuleCreate(Sender: TObject);
38 procedure DataModuleDestroy(Sender: TObject);
39 procedure Translator1Translate(Sender: TObject);
40 private
41 procedure GameChange(Sender: TObject);
42 procedure GamePaint(Sender: TObject);
43 procedure GameWin(Sender: TObject);
44 procedure GameWinSync;
45 procedure GameOver(Sender: TObject);
46 procedure GameOverSync;
47 public
48 Game: TGame;
49 procedure UpdateInterface;
50 procedure LoadConfig;
51 procedure SaveConfig;
52 end;
53
54var
55 Core: TCore;
56
57implementation
58
59{$R *.lfm}
60
61uses
62 UFormMain, UFormSettings, UFormAbout, UFormNew, UFormHelp, UFormComputer,
63 UFormHistory;
64
65resourcestring
66 SGameOverCaption = 'Lost';
67 SGameOverMessage = 'Game over!';
68 SWinCaption = 'Win';
69 SWinMessage = 'You reached %s and won! You can continue to play to get higher score.';
70
71{ TCore }
72
73procedure TCore.DataModuleCreate(Sender: TObject);
74begin
75 {$IFDEF Linux}
76 // If installed in Linux system then use installation directory for po files
77 if Application.ExeName = '/usr/bin/Game2048' then
78 Translator1.POFilesFolder := '/usr/share/Game2048/languages';
79 {$ENDIF}
80
81 Randomize;
82 Game := TGame.Create;
83 Game.Board.Size := Point(4, 4);
84 Game.OnChange := GameChange;
85 Game.OnPaint := GamePaint;
86 Game.OnWin := GameWin;
87 Game.OnGameOver := GameOver;
88 LoadConfig;
89end;
90
91procedure TCore.ASettingsExecute(Sender: TObject);
92begin
93 FormSettings := TFormSettings.Create(nil);
94 try
95 if FormSettings.ShowModal = mrOk then begin
96 FormMain.Redraw;
97 FormMain.UpdateInterface;
98 UpdateInterface;
99 end;
100 finally
101 FreeAndNil(FormSettings);
102 end;
103end;
104
105procedure TCore.AUndoExecute(Sender: TObject);
106begin
107 Game.Undo;
108end;
109
110procedure TCore.AAboutExecute(Sender: TObject);
111begin
112 FormAbout := TFormAbout.Create(nil);
113 try
114 FormAbout.ApplicationInfo := Core.ApplicationInfo1;
115 FormAbout.ShowModal;
116 finally
117 FreeAndNil(FormAbout);
118 end;
119end;
120
121procedure TCore.AComputerExecute(Sender: TObject);
122begin
123 FormComputer := TFormComputer.Create(nil);
124 try
125 FormComputer.ShowModal;
126 finally
127 FreeAndNil(FormComputer);
128 end;
129end;
130
131procedure TCore.AExitExecute(Sender: TObject);
132begin
133 FormMain.Close;
134end;
135
136procedure TCore.AHelpExecute(Sender: TObject);
137begin
138 FormHelp := TFormHelp.Create(nil);
139 try
140 FormHelp.ShowModal;
141 finally
142 FreeAndNil(FormHelp);
143 end;
144end;
145
146procedure TCore.AHistoryExecute(Sender: TObject);
147begin
148 FormHistory := TFormHistory.Create(nil);
149 try
150 FormHistory.ShowModal;
151 finally
152 FreeAndNil(FormHistory);
153 end;
154end;
155
156procedure TCore.ANewExecute(Sender: TObject);
157begin
158 FormNew := TFormNew.Create(nil);
159 try
160 FormNew.Load(Core.Game);
161 if FormNew.ShowModal = mrOk then begin
162 FormNew.Save(Core.Game);
163 Game.New;
164 UpdateInterface;
165 FormMain.UpdateInterface;
166 end;
167 finally
168 FreeAndNil(FormNew);
169 end;
170end;
171
172procedure TCore.DataModuleDestroy(Sender: TObject);
173begin
174 SaveConfig;
175 FreeAndNil(Game);
176end;
177
178procedure TCore.Translator1Translate(Sender: TObject);
179begin
180 UGame.Translate;
181end;
182
183procedure TCore.GameChange(Sender: TObject);
184begin
185 UpdateInterface;
186end;
187
188procedure TCore.GamePaint(Sender: TObject);
189begin
190 if Assigned(FormMain) then FormMain.Redraw;
191end;
192
193procedure TCore.GameWin(Sender: TObject);
194begin
195 TThread.Synchronize(FormMain.MoveThread, GameWinSync);
196end;
197
198procedure TCore.GameWinSync;
199begin
200 MessageDlg(SWinCaption, Format(SWinMessage, [Game.GetTileSkinValue(Game.WinTileValue)]), mtInformation, [mbOk], 0);
201end;
202
203procedure TCore.GameOver(Sender: TObject);
204begin
205 TThread.Synchronize(FormMain.MoveThread, GameOverSync);
206end;
207
208procedure TCore.GameOverSync;
209begin
210 MessageDlg(SGameOverCaption, SGameOverMessage, mtInformation, [mbOK], 0);
211end;
212
213procedure TCore.UpdateInterface;
214begin
215 AUndo.Enabled := Game.CanUndo;
216 AHistory.Enabled := Game.RecordHistory;
217 {$IFDEF DEBUG}
218 AComputer.Enabled := True;
219 AComputer.Visible := True;
220 {$ELSE}
221 AComputer.Enabled := False;
222 AComputer.Visible := False;
223 {$ENDIF}
224end;
225
226procedure TCore.LoadConfig;
227begin
228 with TRegistryEx.Create do
229 try
230 CurrentContext := ApplicationInfo1.GetRegistryContext;
231
232 if ValueExists('LanguageCode') then
233 Translator1.Language := Translator1.Languages.SearchByCode(ReadStringWithDefault('LanguageCode', ''))
234 else Translator1.Language := Translator1.Languages.SearchByCode('');
235 ThemeManager1.Theme := ThemeManager1.Themes.FindByName(ReadStringWithDefault('Theme', 'System'));
236 finally
237 Free;
238 end;
239 Game.LoadFromRegistry(ApplicationInfo1.GetRegistryContext);
240end;
241
242procedure TCore.SaveConfig;
243begin
244 with TRegistryEx.Create do
245 try
246 CurrentContext := ApplicationInfo1.GetRegistryContext;
247
248 if Assigned(Translator1.Language) and (Translator1.Language.Code <> '') then
249 WriteString('LanguageCode', Translator1.Language.Code)
250 else DeleteValue('LanguageCode');
251 WriteString('Theme', ThemeManager1.Theme.Name);
252 finally
253 Free;
254 end;
255 Game.SaveToRegistry(ApplicationInfo1.GetRegistryContext);
256end;
257
258end.
259
Note: See TracBrowser for help on using the repository browser.