close Warning: Can't synchronize with repository "(default)" (No changeset 184 in the repository). Look in the Trac log for more information.

source: tags/1.2.0/UCore.pas

Last change on this file was 158, checked in by chronos, 6 years ago
  • Fixed: Show error message if not all players were placed to the map.
File size: 13.4 KB
Line 
1unit UCore;
2
3{$mode delphi}
4
5interface
6
7uses
8 Classes, SysUtils, XMLConf, FileUtil, ActnList, Controls, Dialogs, Forms,
9 UGame, UApplicationInfo, UPersistentForm, UScaleDPI, UCoolTranslator,
10 URegistry, ULastOpenedList, Registry, Menus;
11
12type
13
14 { TCore }
15
16 TCore = class(TDataModule)
17 AAbout: TAction;
18 AShowUnitMoves: TAction;
19 AShowCharts: TAction;
20 AHelp: TAction;
21 AGameSave: TAction;
22 AGameLoad: TAction;
23 ApplicationInfo: TApplicationInfo;
24 ASettings: TAction;
25 ActionList1: TActionList;
26 AExit: TAction;
27 AGameEnd: TAction;
28 AGameEndTurn: TAction;
29 AGameNew: TAction;
30 AGameRestart: TAction;
31 CoolTranslator1: TCoolTranslator;
32 ImageListLarge: TImageList;
33 ImageListSmall: TImageList;
34 LastOpenedList1: TLastOpenedList;
35 OpenDialog1: TOpenDialog;
36 PersistentForm: TPersistentForm;
37 SaveDialog1: TSaveDialog;
38 ScaleDPI1: TScaleDPI;
39 XMLConfig1: TXMLConfig;
40 procedure AAboutExecute(Sender: TObject);
41 procedure AExitExecute(Sender: TObject);
42 procedure AGameEndExecute(Sender: TObject);
43 procedure AGameEndTurnExecute(Sender: TObject);
44 procedure AGameLoadExecute(Sender: TObject);
45 procedure AGameNewExecute(Sender: TObject);
46 procedure AGameRestartExecute(Sender: TObject);
47 procedure AGameSaveExecute(Sender: TObject);
48 procedure AHelpExecute(Sender: TObject);
49 procedure ASettingsExecute(Sender: TObject);
50 procedure AShowChartsExecute(Sender: TObject);
51 procedure AShowUnitMovesExecute(Sender: TObject);
52 procedure CoolTranslator1Translate(Sender: TObject);
53 procedure DataModuleCreate(Sender: TObject);
54 procedure DataModuleDestroy(Sender: TObject);
55 procedure LastOpenedList1Change(Sender: TObject);
56 private
57 FInitialized: Boolean;
58 StoredDimension: TControlDimension;
59 RegistryContext: TRegistryContext;
60 procedure LoadRecentExecute(Sender: TObject);
61 procedure ProcessComputerTurns;
62 procedure StartNewGame;
63 procedure DoPlayerChange(Sender: TObject);
64 procedure DoMoveUpdated(UnitMove: TUnitMove);
65 procedure DoOnMove(CellFrom, CellTo: TCell; var CountOnce,
66 CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
67 procedure DoOnWin(Player: TPlayer);
68 procedure Delay(Time: Integer);
69 procedure GameNewTurnExecute(Sender: TObject);
70 procedure AutoSave;
71 function GetPlayer: TPlayer;
72 procedure LoadConfig;
73 procedure SaveConfig;
74 procedure CommandLineParams;
75 procedure ScaleDPI;
76 procedure SelectClient;
77 procedure LoadGame(FileName: string);
78 public
79 Game: TGame;
80 UseSingleView: Boolean;
81 DevelMode: Boolean;
82 AnimationSpeed: Integer;
83 AutoSaveEnabled: Boolean;
84 CurrentClient: TClient;
85 procedure UpdateActions;
86 procedure Init;
87 property Initialized: Boolean read FInitialized;
88 end;
89
90var
91 Core: TCore;
92
93
94implementation
95
96{$R *.lfm}
97
98uses
99 UFormMove, UFormMain, UFormNew, UFormSettings, UFormAbout, UFormPlayer,
100 UFormHelp, UFormCharts, UFormUnitMoves;
101
102const
103 DefaultRegKey = '\Software\Chronosoft\xTactics';
104
105resourcestring
106 SPlayerWins = 'Player %s wins';
107 SEndGame = 'End game?';
108 SEndGameQuestion = 'Do you want to end current game?';
109 SRestartGame = 'Restart game?';
110 SRestartGameQuestion = 'Do you want to restart current game?';
111 SPlayersNotInitialized = 'Not all players were initialized with start cell. Needed %d, initialized %d. Change map parameters to have more terrain cells.';
112
113
114{ TCore }
115
116procedure TCore.DoOnMove(CellFrom, CellTo: TCell; var CountOnce,
117 CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
118var
119 I: Integer;
120begin
121 if Update then FormMove.SpinEditOnce.MaxValue := CellFrom.GetAvialPower + CountOnce
122 else FormMove.SpinEditOnce.MaxValue := CellFrom.GetAvialPower;
123 FormMove.SpinEditOnce.Value := CountOnce;
124 FormMove.TrackBarOnce.Max := FormMove.SpinEditOnce.MaxValue;
125 FormMove.TrackBarOnce.Position := FormMove.SpinEditOnce.Value;
126 FormMove.SpinEditRepeat.MaxValue := Game.Map.MaxPower;
127 FormMove.SpinEditRepeat.Value := CountRepeat;
128 FormMove.TrackBarRepeat.Max := FormMove.SpinEditRepeat.MaxValue;
129 FormMove.TrackBarRepeat.Position := FormMove.SpinEditRepeat.Value;
130 FormMove.DefendCount := CellTo.Power;
131 // Attack count from other surrounding cells without current move if already exists
132 FormMove.AttackCount := 0;
133 for I := 0 to CellTo.MovesTo.Count - 1 do
134 if TUnitMove(CellTo.MovesTo[I]).CellFrom <> CellFrom then
135 FormMove.AttackCount := FormMove.AttackCount + TUnitMove(CellTo.MovesTo[I]).CountOnce;
136 FormMove.ShowWinProbability := CellTo.Player <> CellFrom.Player;
137
138 if FormMove.ShowModal = mrOk then begin
139 CountOnce := FormMove.SpinEditOnce.Value;
140 CountRepeat := FormMove.SpinEditRepeat.Value;
141 Confirm := True;
142 end else Confirm := False;
143end;
144
145procedure TCore.DoOnWin(Player: TPlayer);
146begin
147 FormMain.Redraw;
148 ShowMessage(Format(SPlayerWins, [Player.Name]));
149end;
150
151procedure TCore.Delay(Time: Integer);
152const
153 Slice = 50; // ms
154begin
155 while Time > 0 do begin
156 Application.ProcessMessages;
157 if Time > Slice then Sleep(Slice) else Sleep(Time);
158 Dec(Time, Slice);
159 end;
160end;
161
162procedure TCore.GameNewTurnExecute(Sender: TObject);
163begin
164 if AutoSaveEnabled then AutoSave;
165end;
166
167procedure TCore.AutoSave;
168var
169 OldFileName: string;
170begin
171 OldFileName := Game.FileName;
172 Game.SaveToFile(GetAppConfigDir(False) + 'AutoSave.xtg');
173 Game.FileName := OldFileName;
174end;
175
176function TCore.GetPlayer: TPlayer;
177begin
178 Result := Game.CurrentPlayer;
179end;
180
181procedure TCore.LoadConfig;
182begin
183 RegistryContext := RegContext(HKEY_CURRENT_USER, DefaultRegKey);
184 PersistentForm.RegistryContext := RegistryContext;
185 XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';
186
187 LastOpenedList1.LoadFromXMLConfig(XMLConfig1, 'RecentFiles');
188 DevelMode := XMLConfig1.GetValue('DevelMode', false);
189 AnimationSpeed := XMLConfig1.GetValue('AnimationSpeed', 50);
190 AutoSaveEnabled := XMLConfig1.GetValue('AutoSave', True);
191 CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode(String(XMLConfig1.GetValue('Language', '')));
192 ScaleDPI1.DPI := Point(XMLConfig1.GetValue('DPIX', 96), XMLConfig1.GetValue('DPIY', 96));
193 ScaleDPI1.AutoDetect := XMLConfig1.GetValue('DPIAuto', True);
194end;
195
196procedure TCore.SaveConfig;
197begin
198 XMLConfig1.SetValue('Language', WideString(CoolTranslator1.Language.Code));
199 LastOpenedList1.SaveToXMLConfig(XMLConfig1, 'RecentFiles');
200 XMLConfig1.SetValue('DevelMode', DevelMode);
201 XMLConfig1.SetValue('AnimationSpeed', AnimationSpeed);
202 XMLConfig1.SetValue('AutoSave', AutoSaveEnabled);
203 XMLConfig1.SetValue('DPIX', ScaleDPI1.DPI.X);
204 XMLConfig1.SetValue('DPIY', ScaleDPI1.DPI.Y);
205 XMLConfig1.SetValue('DPIAuto', ScaleDPI1.AutoDetect);
206end;
207
208procedure TCore.CommandLineParams;
209var
210 FileName: string;
211begin
212 // Command line parameter handling
213 if (ParamCount > 0) then begin
214 FileName := UTF8Encode(ParamStr(1));
215 if FileExists(FileName) then LoadGame(FileName);
216 end;
217end;
218
219procedure TCore.ScaleDPI;
220var
221 I: Integer;
222begin
223 {$ifdef DEBUG}
224 with Core.ScaleDPI1 do begin
225 //DesignDPI := Point(144, 144);
226 if (DesignDPI.X <> DPI.X) or (DesignDPI.Y <> DPI.Y) then begin
227 //ApplyToAll(DesignDPI);
228 FormNew.Show;
229 FormNew.Hide;
230 for I := 0 to Screen.FormCount - 1 do
231 if (Screen.Forms[I].WindowState = wsNormal) or
232 (Screen.Forms[I].WindowState = wsMinimized) then begin
233 StoreDimensions(Screen.Forms[I], StoredDimension);
234 ScaleDimensions(Screen.Forms[I], StoredDimension);
235 end;
236 ScaleImageList(Core.ImageListSmall, DesignDPI);
237 ScaleImageList(Core.ImageListLarge, DesignDPI);
238 end;
239 end;
240 {$endif}
241end;
242
243procedure TCore.SelectClient;
244var
245 FirstHuman: TPlayer;
246begin
247 FirstHuman := Game.Players.GetFirstHuman;
248 if Assigned(FirstHuman) then CurrentClient := FirstHuman.Client
249 else CurrentClient := TClient(Game.Clients.First);
250end;
251
252procedure TCore.UpdateActions;
253begin
254 Core.AGameEndTurn.Enabled := Core.Game.Running;
255 Core.AGameEnd.Enabled := Core.Game.Running;
256end;
257
258procedure TCore.AExitExecute(Sender: TObject);
259begin
260 Game.Running := False;
261 Application.Terminate;
262end;
263
264procedure TCore.AAboutExecute(Sender: TObject);
265begin
266 FormAbout := TFormAbout.Create(Self);
267 try
268 FormAbout.ShowModal;
269 finally
270 FreeAndNil(FormAbout);
271 end;
272end;
273
274procedure TCore.AGameEndExecute(Sender: TObject);
275begin
276 if MessageDlg(SEndGame, SEndGameQuestion, mtConfirmation, mbYesNo, 0) = mrYes then begin
277 Game.Running := False;
278 FormMain.Redraw;
279 UpdateActions;
280 end;
281end;
282
283procedure TCore.ProcessComputerTurns;
284begin
285 while Game.Running and (Game.CurrentPlayer.Mode <> pmHuman) do begin
286 if Game.CurrentPlayer.Mode = pmComputer then begin
287 Game.CurrentPlayer.Computer.Process;
288 FormMain.Redraw;
289 Delay(Trunc((100 - AnimationSpeed) / 100 * 2000));
290 end;
291 Game.NextTurn;
292 FormMain.Redraw;
293 Application.ProcessMessages;
294 Sleep(1);
295 end;
296end;
297
298procedure TCore.AGameEndTurnExecute(Sender: TObject);
299begin
300 Game.NextTurn;
301 FormMain.Redraw;
302 ProcessComputerTurns;
303 UpdateActions;
304end;
305
306procedure TCore.AGameLoadExecute(Sender: TObject);
307begin
308 if (Game.FileName = '') and (LastOpenedList1.Items.Count > 0) then
309 OpenDialog1.FileName := LastOpenedList1.Items[0]
310 else OpenDialog1.FileName := Game.FileName;
311 if OpenDialog1.Execute then begin
312 LoadGame(OpenDialog1.FileName);
313 end;
314end;
315
316procedure TCore.AGameNewExecute(Sender: TObject);
317begin
318 FormNew.Load(Game);
319 if FormNew.ShowModal = mrOk then begin
320 FormNew.Save(Game);
321 StartNewGame;
322 end;
323end;
324
325procedure TCore.AGameRestartExecute(Sender: TObject);
326begin
327 if MessageDlg(SRestartGame, SRestartGameQuestion, mtConfirmation, mbYesNo, 0) = mrYes then begin
328 StartNewGame;
329 end;
330end;
331
332procedure TCore.AGameSaveExecute(Sender: TObject);
333begin
334 if (Game.FileName = '') and (LastOpenedList1.Items.Count > 0) then
335 SaveDialog1.FileName := ExtractFileDir(LastOpenedList1.Items[0])
336 else SaveDialog1.FileName := Game.FileName;
337 if SaveDialog1.Execute then begin
338 Game.SaveToFile(SaveDialog1.FileName);
339 LastOpenedList1.AddItem(SaveDialog1.FileName);
340 end;
341end;
342
343procedure TCore.AHelpExecute(Sender: TObject);
344begin
345 FormHelp := TFormHelp.Create(Self);
346 try
347 FormHelp.ShowModal;
348 finally
349 FreeAndNil(FormHelp);
350 end;
351end;
352
353procedure TCore.ASettingsExecute(Sender: TObject);
354begin
355 FormSettings := TFormSettings.Create(nil);
356 try
357 FormSettings.Load;
358 if FormSettings.ShowModal = mrOk then begin
359 FormSettings.Save;
360 Game.SaveConfig(XMLConfig1, 'Game');
361 end;
362 finally
363 FreeAndNil(FormSettings);
364 end;
365end;
366
367procedure TCore.AShowChartsExecute(Sender: TObject);
368begin
369 FormCharts.Show;
370end;
371
372procedure TCore.AShowUnitMovesExecute(Sender: TObject);
373begin
374 FormUnitMoves.Show;
375end;
376
377procedure TCore.CoolTranslator1Translate(Sender: TObject);
378begin
379 UGame.InitStrings;
380 FormNew.Translate;
381 FormPlayer.Translate;
382end;
383
384procedure TCore.DataModuleCreate(Sender: TObject);
385begin
386 Game := TGame.Create;
387 Game.OnMove := DoOnMove;
388 Game.OnMoveUpdated := DoMoveUpdated;
389 Game.OnWin := DoOnWin;
390 Game.OnNewTurn := GameNewTurnExecute;
391 Game.OnPlayerChange := DoPlayerChange;
392 StoredDimension := TControlDimension.Create;
393 XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';
394 ForceDirectories(GetAppConfigDir(False));
395end;
396
397procedure TCore.DataModuleDestroy(Sender: TObject);
398begin
399 StoredDimension.Free;;
400 Game.SaveConfig(XMLConfig1, 'Game');
401 SaveConfig;
402 FreeAndNil(Game);
403end;
404
405procedure TCore.LastOpenedList1Change(Sender: TObject);
406begin
407 LastOpenedList1.LoadToMenuItem(FormMain.MenuItemLoadRecent, LoadRecentExecute);
408end;
409
410procedure TCore.LoadRecentExecute(Sender: TObject);
411begin
412 LoadGame((Sender as TMenuItem).Caption);
413end;
414
415procedure TCore.LoadGame(FileName: string);
416begin
417 Game.LoadFromFile(FileName);
418 SelectClient;
419 LastOpenedList1.AddItem(FileName);
420 with Core.CurrentClient do
421 View.DestRect := Bounds(0, 0, FormMain.PaintBox1.Width, FormMain.PaintBox1.Height);
422 FormMain.AZoomAll.Execute;
423 FormMain.Redraw;
424 if FormCharts.Visible then FormCharts.Redraw;
425 if FormUnitMoves.Visible then FormUnitMoves.ReloadList;
426end;
427
428procedure TCore.StartNewGame;
429begin
430 Game.New;
431 SelectClient;
432 if Game.Players.GetAliveCount = Game.Players.Count then Game.Running := True
433 else ShowMessage(Format(SPlayersNotInitialized, [Game.Players.Count, Game.Players.GetAliveCount]));
434 FormMain.Redraw;
435 if FormCharts.Visible then FormCharts.Redraw;
436 if FormUnitMoves.Visible then FormUnitMoves.ReloadList;
437 ProcessComputerTurns;
438 UpdateActions;
439end;
440
441procedure TCore.DoPlayerChange(Sender: TObject);
442begin
443 if Assigned(Game.CurrentPlayer) and Assigned(Game.CurrentPlayer.Client) then
444 CurrentClient := Game.CurrentPlayer.Client;
445 if FormCharts.Visible then FormCharts.Redraw;
446 if FormUnitMoves.Visible then FormUnitMoves.ReloadList;
447end;
448
449procedure TCore.DoMoveUpdated(UnitMove: TUnitMove);
450begin
451 if FormUnitMoves.Visible then FormUnitMoves.ReloadList;
452end;
453
454procedure TCore.Init;
455begin
456 if not Core.Initialized then begin
457 {$IFDEF Linux}
458 // If installed in Linux system then use installation directory for po files
459 if Application.ExeName = '/usr/bin/xtactics' then
460 CoolTranslator1.POFilesFolder := '/usr/share/xtactics/languages';
461 {$ENDIF}
462 FInitialized := True;
463
464 // Update translated default player names
465 TPlayer(Game.PlayersSetting[0]).Name := SPlayer + ' 1';
466 TPlayer(Game.PlayersSetting[1]).Name := SPlayer + ' 2';
467
468 LoadConfig;
469 Game.LoadConfig(XMLConfig1, 'Game');
470
471 CommandLineParams;
472 ScaleDPI;
473
474 if Game.FileName = '' then StartNewGame;
475 end;
476end;
477
478end.
479
Note: See TracBrowser for help on using the repository browser.