source: trunk/Core.pas

Last change on this file was 339, checked in by chronos, 3 months ago
  • Modified: Moved unit kinds into separate unit.
File size: 24.0 KB
Line 
1unit Core;
2
3interface
4
5uses
6 Classes, SysUtils, XMLConf, FileUtil, ActnList, Controls, Dialogs, Forms,
7 Game, ApplicationInfo, PersistentForm, ScaleDPI, Translator, DOM,
8 RegistryEx, LastOpenedList, Theme, Registry, Menus, FormCharts, FormMain,
9 FormClient, Player, GameServer, GameClient, ServerList, GameSystem, Graphics;
10
11type
12
13 { TCore }
14
15 TCore = class(TDataModule)
16 AAbout: TAction;
17 AGameSystems: TAction;
18 ATests: TAction;
19 AFullscreen: TAction;
20 AToggleFogOfWar: TAction;
21 AShowKeyShortcuts: TAction;
22 AGameSave: TAction;
23 APlayersStats: TAction;
24 ANewSpectatorClient: TAction;
25 AShowUnitMoves: TAction;
26 AShowCharts: TAction;
27 AHelp: TAction;
28 AGameSaveAs: TAction;
29 AGameLoad: TAction;
30 ApplicationInfo: TApplicationInfo;
31 ASettings: TAction;
32 ActionListMain: TActionList;
33 AExit: TAction;
34 AGameEnd: TAction;
35 AGameNew: TAction;
36 AGameRestart: TAction;
37 Translator1: TTranslator;
38 ImageListLarge: TImageList;
39 ImageListSmall: TImageList;
40 LastOpenedList1: TLastOpenedList;
41 OpenDialog1: TOpenDialog;
42 PersistentForm1: TPersistentForm;
43 SaveDialog1: TSaveDialog;
44 ScaleDPI1: TScaleDPI;
45 ThemeManager1: TThemeManager;
46 XMLConfig1: TXMLConfig;
47 procedure AAboutExecute(Sender: TObject);
48 procedure AExitExecute(Sender: TObject);
49 procedure AFullscreenExecute(Sender: TObject);
50 procedure AGameEndExecute(Sender: TObject);
51 procedure AGameLoadExecute(Sender: TObject);
52 procedure AGameNewExecute(Sender: TObject);
53 procedure AGameRestartExecute(Sender: TObject);
54 procedure AGameSaveAsExecute(Sender: TObject);
55 procedure AGameSaveExecute(Sender: TObject);
56 procedure AGameSystemsExecute(Sender: TObject);
57 procedure AHelpExecute(Sender: TObject);
58 procedure ANewSpectatorClientExecute(Sender: TObject);
59 procedure APlayersStatsExecute(Sender: TObject);
60 procedure ASettingsExecute(Sender: TObject);
61 procedure AShowChartsExecute(Sender: TObject);
62 procedure AShowKeyShortcutsExecute(Sender: TObject);
63 procedure AShowUnitMovesExecute(Sender: TObject);
64 procedure ATestsExecute(Sender: TObject);
65 procedure AToggleFogOfWarExecute(Sender: TObject);
66 procedure Translator1Translate(Sender: TObject);
67 procedure DataModuleCreate(Sender: TObject);
68 procedure DataModuleDestroy(Sender: TObject);
69 procedure LastOpenedList1Change(Sender: TObject);
70 private
71 FInitialized: Boolean;
72 StoredDimension: TControlDimension;
73 RegistryContext: TRegistryContext;
74 GameLoaded: Boolean;
75 FormNewTabIndex: Integer;
76 GameFilesDir: string;
77 procedure LoadRecentExecute(Sender: TObject);
78 procedure StartNewGame;
79 procedure LoadGame(FileName: string);
80 procedure DoPlayerChange(Sender: TObject);
81 procedure DoMoveUpdated(UnitMove: TUnitMove);
82 procedure DoOnWin(Player: TPlayer);
83 procedure Delay(Time: Integer);
84 procedure GameNewTurnExecute(Sender: TObject);
85 procedure AutoSave;
86 procedure CommandLineParams;
87 procedure SelectClient;
88 procedure UpdateOtherForms;
89 procedure FormClientActions;
90 procedure LoadGameSystems;
91 public
92 Game: TGame;
93 GameSettings: TGame;
94 Server: TServer;
95 UseSingleView: Boolean;
96 DevelMode: Boolean;
97 AnimationSpeed: Integer;
98 CellGridVisible: Boolean;
99 UnitShapeVisible: Boolean;
100 AutoSaveEnabled: Boolean;
101 ReopenLastFile: Boolean;
102 FormClients: TFormClients;
103 LocalClients: TClients;
104 ServerList: TServerList;
105 GameSystems: TGameSystems;
106 FormMain: TFormMain;
107 procedure ReopenGameOnInit;
108 procedure LoadConfig;
109 procedure SaveConfig;
110 procedure SaveConfigAll;
111 procedure Spectate(Player: TPlayer);
112 procedure UpdateInterface;
113 procedure ScaleDPI;
114 procedure Init;
115 procedure Done;
116 property Initialized: Boolean read FInitialized;
117 end;
118
119var
120 Core: TCore;
121
122const
123 clOrange = $009Aff;
124 clBrown = $a52A2A;
125
126
127implementation
128
129{$R *.lfm}
130
131uses
132 FormNew, FormSettings, ClientAI, FormKeyShortcuts, Common, FormEx, FormTests,
133 FormHelp, FormUnitMoves, FormPlayersStats, ClientGUI, FormAbout, Tests,
134 FormGameSystems, UnitKind;
135
136const
137 DefaultRegKey = '\Software\Chronosoft\xTactics';
138
139resourcestring
140 SPlayerWins = 'Player %s wins';
141 SPlayersWins = 'Players %s win';
142 SEndGame = 'End game?';
143 SEndGameQuestion = 'Do you want to end current game?';
144 SRestartGame = 'Restart game?';
145 SRestartGameQuestion = 'Do you want to restart current game?';
146 SPlayersNotInitialized = 'Not all players were initialized with start cell. Needed %d, initialized %d. Change map parameters to have more terrain cells.';
147 SFileDialogFilter = 'xTactics games (.xtg)|*.xtg|All files|*.*';
148 SMissingServerClientForPlayer = 'Server client for current player not found.';
149
150procedure Translate;
151begin
152 Game.InitStrings;
153end;
154
155{ TCore }
156
157procedure TCore.DoOnWin(Player: TPlayer);
158var
159 PlayerNames: string;
160 AlivePlayers: TPlayerArray;
161 I: Integer;
162begin
163 Server.GameEnd;
164 if Assigned(Player) then
165 ShowMessage(Format(SPlayerWins, [Player.Name]))
166 else begin
167 AlivePlayers := Game.Players.GetAlivePlayers;
168 PlayerNames := '';
169 for I := 0 to Length(AlivePlayers) - 1 do begin
170 if I > 0 then PlayerNames := PlayerNames + ', ';
171 PlayerNames := PlayerNames + AlivePlayers[I].Name;
172 end;
173 ShowMessage(Format(SPlayersWins, [PlayerNames]))
174 end;
175end;
176
177procedure TCore.Delay(Time: Integer);
178const
179 Slice = 50; // ms
180begin
181 while Time > 0 do begin
182 Application.ProcessMessages;
183 if Time > Slice then Sleep(Slice) else Sleep(Time);
184 Dec(Time, Slice);
185 end;
186end;
187
188procedure TCore.GameNewTurnExecute(Sender: TObject);
189begin
190 if AutoSaveEnabled then AutoSave;
191end;
192
193procedure TCore.AutoSave;
194var
195 OldFileName: string;
196begin
197 OldFileName := Game.FileName;
198 Game.SaveToFile(GetAppConfigDir(False) + 'AutoSave.xtg');
199 Game.FileName := OldFileName;
200end;
201
202procedure TCore.LoadConfig;
203begin
204 RegistryContext := TRegistryContext.Create(HKEY_CURRENT_USER, DefaultRegKey);
205 PersistentForm1.RegistryContext := RegistryContext;
206 XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';
207
208 ThemeManager1.Theme := ThemeManager1.Themes.FindByName(String(XmlConfig1.GetValue('Theme', 'System')));
209 LastOpenedList1.LoadFromXMLConfig(XMLConfig1, 'RecentFiles');
210 DevelMode := XMLConfig1.GetValue('DevelMode', false);
211 AnimationSpeed := XMLConfig1.GetValue('AnimationSpeed', 50);
212 AutoSaveEnabled := XMLConfig1.GetValue('AutoSave', True);
213 ReopenLastFile := XMLConfig1.GetValue('ReopenLastFile', True);
214 Translator1.Language := Translator1.Languages.SearchByCode(String(XMLConfig1.GetValue('Language', '')));
215 ScaleDPI1.DPI := Point(XMLConfig1.GetValue('DPIX', 96), XMLConfig1.GetValue('DPIY', 96));
216 ScaleDPI1.AutoDetect := XMLConfig1.GetValue('DPIAuto', True);
217 FormNewTabIndex := XMLConfig1.GetValue('FormNewTabIndex', 0);
218 CellGridVisible := XMLConfig1.GetValue('CellGridVisible', True);
219 UnitShapeVisible := XMLConfig1.GetValue('UnitShapeVisible', False);
220end;
221
222procedure TCore.SaveConfig;
223begin
224 XMLConfig1.SetValue('Language', WideString(Translator1.Language.Code));
225 XMLConfig1.SetValue('Theme', WideString(ThemeManager1.Theme.Name));
226 LastOpenedList1.SaveToXMLConfig(XMLConfig1, 'RecentFiles');
227 XMLConfig1.SetValue('DevelMode', DevelMode);
228 XMLConfig1.SetValue('AnimationSpeed', AnimationSpeed);
229 XMLConfig1.SetValue('AutoSave', AutoSaveEnabled);
230 XMLConfig1.SetValue('ReopenLastFile', ReopenLastFile);
231 XMLConfig1.SetValue('DPIX', ScaleDPI1.DPI.X);
232 XMLConfig1.SetValue('DPIY', ScaleDPI1.DPI.Y);
233 XMLConfig1.SetValue('DPIAuto', ScaleDPI1.AutoDetect);
234 XMLConfig1.SetValue('FormNewTabIndex', FormNewTabIndex);
235 XMLConfig1.SetValue('CellGridVisible', CellGridVisible);
236 XMLConfig1.SetValue('UnitShapeVisible', UnitShapeVisible);
237end;
238
239procedure TCore.SaveConfigAll;
240begin
241 GameSettings.SaveConfig(XMLConfig1, 'Game');
242 Server.SaveConfig(XMLConfig1, 'Server');
243 ServerList.SaveConfig(XmlConfig1, 'ServerList');
244 SaveConfig;
245 XMLConfig1.Flush;
246end;
247
248procedure TCore.CommandLineParams;
249var
250 FileName: string;
251begin
252 // Command line parameter handling
253 if (ParamCount > 0) then begin
254 FileName := ParamStr(1);
255 if FileExists(FileName) then LoadGame(FileName);
256 end;
257end;
258
259procedure TCore.ScaleDPI;
260var
261 I: Integer;
262begin
263 //{$ifdef DEBUG}
264 with Core.ScaleDPI1 do begin
265 //DesignDPI := Point(144, 144);
266 if (DesignDPI.X <> DPI.X) or (DesignDPI.Y <> DPI.Y) then begin
267 //ApplyToAll(DesignDPI);
268 for I := 0 to Screen.FormCount - 1 do
269 if (Screen.Forms[I].WindowState = wsNormal) or
270 (Screen.Forms[I].WindowState = wsMinimized) then begin
271 StoreDimensions(Screen.Forms[I], StoredDimension);
272 ScaleDimensions(Screen.Forms[I], StoredDimension);
273 end;
274 ScaleImageList(Core.ImageListSmall, DesignDPI);
275 ScaleImageList(Core.ImageListLarge, DesignDPI);
276 end;
277 end;
278 //{$endif}
279end;
280
281procedure TCore.SelectClient;
282var
283 FirstHuman: TPlayer;
284begin
285 FirstHuman := Game.Players.GetFirstHuman;
286 if Assigned(FirstHuman) then FormMain.FormClient.Client := TClientGUI(LocalClients.SearchPlayer(FirstHuman))
287 else begin
288 FormMain.FormClient.Client := TClientGUI(LocalClients.New(SSpectator));
289 FormMain.FormClient.Client.LocalServer := Server;
290 FormMain.FormClient.Client.ConnectType := ctLocal;
291 FormMain.FormClient.Client.Active := True;
292 FormMain.FormClient.AZoomAll.Execute;
293 end;
294end;
295
296procedure TCore.UpdateInterface;
297begin
298 AGameEnd.Enabled := Game.Running;
299 AFullscreen.Checked := FormMain.FullScreen;
300 {$ifdef DEBUG}
301 ATests.Visible := True;
302 ATests.Enabled := True;
303 {$else}
304 ATests.Visible := False;
305 ATests.Enabled := False;
306 {$endif}
307end;
308
309procedure TCore.AExitExecute(Sender: TObject);
310begin
311 Game.Running := False;
312 FormMain.Close;
313 Application.Terminate;
314end;
315
316procedure TCore.AFullscreenExecute(Sender: TObject);
317begin
318 FormMain.ToggleFullscreen;
319 UpdateInterface;
320end;
321
322procedure TCore.AAboutExecute(Sender: TObject);
323var
324 FormAbout: TFormAbout;
325begin
326 FormAbout := TFormAbout.Create(nil);
327 try
328 FormAbout.ApplicationInfo := ApplicationInfo;
329 FormAbout.ShowModal;
330 finally
331 FormAbout.Free;
332 end;
333end;
334
335procedure TCore.AGameEndExecute(Sender: TObject);
336begin
337 if MessageDlg(SEndGame, SEndGameQuestion, mtConfirmation, mbYesNo, 0) = mrYes then begin
338 Game.Running := False;
339 Server.GameEnd;
340 UpdateInterface;
341 end;
342end;
343
344procedure TCore.AGameLoadExecute(Sender: TObject);
345begin
346 OpenDialog1.Filter := SFileDialogFilter;
347 OpenDialog1.InitialDir := ExtractFileDir(Game.FileName);
348 OpenDialog1.FileName := ExtractFileName(Game.FileName);
349 if OpenDialog1.Execute then begin
350 LoadGame(OpenDialog1.FileName);
351 end;
352end;
353
354procedure TCore.AGameNewExecute(Sender: TObject);
355var
356 NewServer: TServer;
357 FormNew: TFormNew;
358begin
359 FormNew := TFormNew.Create(nil);
360 try
361 NewServer := TServer.Create;
362 NewServer.Assign(Server);
363 NewServer.Game := TGame.Create;
364 NewServer.Game.Assign(GameSettings);
365 FormNew.Server := NewServer;
366 FormNew.PageControl1.TabIndex := FormNewTabIndex;
367 if FormNew.ShowModal = mrOk then begin
368 Server.Assign(NewServer);
369 Server.Game := Game;
370 Game.Running := False;
371 Game.PostConfig;
372 Game.Assign(NewServer.Game);
373 GameSettings.Assign(NewServer.Game);
374 SaveConfigAll;
375 StartNewGame;
376 GameLoaded := False;
377 end;
378 FormNewTabIndex := FormNew.PageControl1.TabIndex;
379 NewServer.Game.Free;
380 NewServer.Game := nil;
381 NewServer.Free;
382 finally
383 FormNew.Free;
384 end;
385end;
386
387procedure TCore.AGameRestartExecute(Sender: TObject);
388begin
389 if MessageDlg(SRestartGame, SRestartGameQuestion, mtConfirmation, mbYesNo, 0) = mrYes then begin
390 StartNewGame;
391 end;
392end;
393
394procedure TCore.AGameSaveAsExecute(Sender: TObject);
395begin
396 SaveDialog1.Filter := SFileDialogFilter;
397 SaveDialog1.InitialDir := ExtractFileDir(Game.FileName);
398 SaveDialog1.FileName := ExtractFileName(Game.FileName);
399 if SaveDialog1.Execute then begin
400 Game.SaveToFile(SaveDialog1.FileName);
401 LastOpenedList1.AddItem(SaveDialog1.FileName);
402 end;
403end;
404
405procedure TCore.AGameSaveExecute(Sender: TObject);
406begin
407 if FileExists(Game.FileName) then
408 Game.SaveToFile(Game.FileName)
409 else AGameSaveAs.Execute;
410end;
411
412procedure TCore.AGameSystemsExecute(Sender: TObject);
413var
414 FormGameSystems: TFormGameSystems;
415begin
416 FormGameSystems := TFormGameSystems.Create(nil);
417 try
418 FormGameSystems.GameSystems := GameSystems;
419 FormGameSystems.ShowModal;
420 finally
421 FreeAndNil(FormGameSystems);
422 end;
423end;
424
425procedure TCore.AHelpExecute(Sender: TObject);
426var
427 FormHelp: TFormHelp;
428begin
429 FormHelp := TFormHelp.Create(Self);
430 try
431 FormHelp.ShowModal;
432 finally
433 FreeAndNil(FormHelp);
434 end;
435end;
436
437procedure TCore.ANewSpectatorClientExecute(Sender: TObject);
438begin
439 Spectate(nil);
440end;
441
442procedure TCore.APlayersStatsExecute(Sender: TObject);
443begin
444 if not Assigned(FormMain.FormPlayersStats) then
445 FormMain.FormPlayersStats := TFormPlayersStats.Create(nil);
446 FormMain.FormPlayersStats.OnSpectate := Spectate;
447 FormMain.FormPlayersStats.Game := Game;
448 FormMain.FormPlayersStats.Show;
449end;
450
451procedure TCore.ASettingsExecute(Sender: TObject);
452var
453 FormSettings: TFormSettings;
454begin
455 FormSettings := TFormSettings.Create(nil);
456 try
457 FormSettings.Load;
458 if FormSettings.ShowModal = mrOk then begin
459 FormSettings.Save;
460 Game.SaveConfig(XMLConfig1, 'Game');
461 Server.SaveConfig(XMLConfig1, 'Server');
462 XMLConfig1.Flush;
463 ThemeManager1.UseTheme(FormMain);
464 end;
465 finally
466 FreeAndNil(FormSettings);
467 end;
468end;
469
470procedure TCore.AShowChartsExecute(Sender: TObject);
471begin
472 if not Assigned(FormMain.FormCharts) then
473 FormMain.FormCharts := TFormCharts.Create(nil);
474 FormMain.FormCharts.Game := Game;
475 FormMain.FormCharts.Show;
476end;
477
478procedure TCore.AShowKeyShortcutsExecute(Sender: TObject);
479begin
480 if not Assigned(FormMain.FormKeyShortcuts) then
481 FormMain.FormKeyShortcuts := TFormKeyShortcuts.Create(nil);
482 with FormMain.FormKeyShortcuts do begin
483 SourceComponents.Clear;
484 SourceComponents.Add(Self);
485 SourceComponents.Add(FormMain);
486 Show;
487 end;
488end;
489
490procedure TCore.AShowUnitMovesExecute(Sender: TObject);
491begin
492 if not Assigned(FormMain.FormUnitMoves) then
493 FormMain.FormUnitMoves := TFormUnitMoves.Create(nil);
494 FormMain.FormUnitMoves.Game := Game;
495 FormMain.FormUnitMoves.Show;
496end;
497
498procedure TCore.ATestsExecute(Sender: TObject);
499var
500 FormTests: TFormTests;
501begin
502 FormTests := TFormTests.Create(nil);
503 FormTests.TestCases := GetTestCases;
504 FormTests.ShowModal;
505 FormTests.Free;
506end;
507
508procedure TCore.AToggleFogOfWarExecute(Sender: TObject);
509begin
510 Game.FogOfWar := not Game.FogOfWar;
511 Server.DoChange(Self);
512end;
513
514procedure TCore.Translator1Translate(Sender: TObject);
515begin
516 Translate;
517 if Assigned(FormMain) then
518 Translator1.TranslateComponentRecursive(FormMain.FormClient);
519end;
520
521procedure TCore.DataModuleCreate(Sender: TObject);
522{$IFDEF Linux}
523const
524 LinuxGameFilesDir = '/usr/share/xtactics';
525 LinuxLanguagesDir = LinuxGameFilesDir + '/Languages';
526{$ENDIF}
527begin
528 GameFilesDir := '';
529 {$IFDEF Linux}
530 // If installed in Linux system then use installation shared game directory for data files
531 if DirectoryExists(LinuxGameFilesDir) then
532 GameFilesDir := LinuxGameFilesDir;
533 // If installed in Linux system then use installation directory for po files
534 if not DirectoryExists(Translator1.POFilesFolder) and DirectoryExists(LinuxLanguagesDir) then
535 Translator1.POFilesFolder := LinuxLanguagesDir;
536 {$ENDIF}
537
538 GameSystems := TGameSystems.Create;
539 Server := TServer.Create;
540 LocalClients := TClients.Create;
541 GameSettings := TGame.Create;
542 GameSettings.FileName := 'Settings';
543 Game := TGame.Create;
544 Game.OnMoveUpdated := DoMoveUpdated;
545 Game.OnWin := DoOnWin;
546 Game.OnNewTurn := GameNewTurnExecute;
547 Game.OnPlayerChange := DoPlayerChange;
548 Game.MapImageFileName := CombinePaths(GameFilesDir, 'Images' + DirectorySeparator + 'Maps' + DirectorySeparator + 'WorldMap.png');
549 Server.Game := Game;
550 LocalClients.Game := Game;
551 StoredDimension := TControlDimension.Create;
552 XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';
553 ForceDirectories(GetAppConfigDir(False));
554 FormClients := TFormClients.Create;
555 ServerList := TServerList.Create;
556
557 LoadConfig;
558
559 TFormEx.ScaleDPI := ScaleDPI1;
560 TFormEx.Translator := Translator1;
561 TFormEx.ThemeManager := ThemeManager1;
562 TFormEx.PersistentForm := PersistentForm1;
563
564 Application.CreateForm(TFormMain, FormMain);
565 FormMain.Show;
566end;
567
568procedure TCore.DataModuleDestroy(Sender: TObject);
569begin
570 FreeAndNil(ServerList);
571 FreeAndNil(FormClients);
572 FreeAndNil(StoredDimension);
573 FreeAndNil(Server);
574 FreeAndNil(LocalClients);
575 FreeAndNil(Game);
576 FreeAndNil(GameSettings);
577 FreeAndNil(GameSystems);
578end;
579
580procedure TCore.LastOpenedList1Change(Sender: TObject);
581begin
582 if Assigned(FormMain) then
583 LastOpenedList1.LoadToMenuItem(FormMain.MenuItemLoadRecent, LoadRecentExecute);
584end;
585
586procedure TCore.LoadRecentExecute(Sender: TObject);
587begin
588 LoadGame((Sender as TMenuItem).Caption);
589end;
590
591procedure TCore.LoadGame(FileName: string);
592var
593 I: Integer;
594 NewClient: TClient;
595 ServerClient: TServerClient;
596 Player: TPlayer;
597begin
598 GameLoaded := True;
599
600 Game.LoadFromFile(FileName);
601 Server.InitClients;
602 Server.Active := True;
603
604 // Create local LocalClients for human players
605 LocalClients.Clear;
606 FormMain.FormClient.Client := nil;
607 for I := 0 to Game.Players.Count - 1 do begin
608 Player := TPlayer(Game.Players[I]);
609 with Player do
610 if Mode = pmHuman then begin
611 NewClient := LocalClients.New(Name);
612 NewClient.ControlPlayer := Player;
613 TClientGUI(NewClient).View.Clear;
614 TClientGUI(NewClient).View.Zoom := 1;
615 NewClient.LocalServer := Server;
616 NewClient.ConnectType := ctLocal;
617 NewClient.Active := True;
618 if Assigned(NewClient.ControlPlayer.StartCell) then
619 TClientGUI(NewClient).View.CenterPlayerCity(NewClient.ControlPlayer)
620 else TClientGUI(NewClient).View.CenterMap;
621 end else
622 if Mode = pmComputer then begin
623 NewClient := TComputer.Create;
624 NewClient.Game := TGame(Game);
625 NewClient.Name := Name;
626 LocalClients.Add(NewClient);
627 NewClient.ControlPlayer := Player;
628 NewClient.LocalServer := Server;
629 NewClient.ConnectType := ctLocal;
630 NewClient.Active := True;
631 end;
632 end;
633
634 SelectClient;
635 LastOpenedList1.AddItem(FileName);
636 UpdateOtherForms;
637 UpdateInterface;
638 ServerClient := Server.Clients.SearchByPlayer(Game.CurrentPlayer);
639 if Assigned(ServerClient) then ServerClient.TurnStart
640 else raise Exception.Create(SMissingServerClientForPlayer);
641 FormMain.FormClient.AZoomAll.Execute;
642end;
643
644procedure TCore.UpdateOtherForms;
645begin
646 if Assigned(FormMain.FormCharts) and FormMain.FormCharts.Visible then
647 FormMain.FormCharts.Redraw;
648 if Assigned(FormMain.FormUnitMoves) and FormMain.FormUnitMoves.Visible then
649 FormMain.FormUnitMoves.ReloadList;
650 if Assigned(FormMain.FormPlayersStats) and FormMain.FormPlayersStats.Visible then
651 FormMain.FormPlayersStats.ReloadList;
652end;
653
654procedure TCore.FormClientActions;
655var
656 Action: TAction;
657 I: Integer;
658begin
659 // Copy all actions from docked form to main form so keyboard shortcuts will be active
660 for I := 0 to FormMain.FormClient.ActionList1.ActionCount - 1 do begin
661 Action := TAction.Create(FormMain);
662 Action.Assign(TAction(FormMain.FormClient.ActionList1.Actions[I]));
663 Action.ActionList := FormMain.ActionList1;
664 end;
665end;
666
667procedure TCore.LoadGameSystems;
668var
669 NewGameSystem: TGameSystem;
670 NewUnitKind: TUnitKind;
671 SystemsDir: string;
672const
673 GameSystemsDirName = 'Systems';
674 DefaultGameSystemName = 'Default';
675begin
676 if GameFilesDir <> '' then
677 SystemsDir := GameFilesDir + DirectorySeparator + GameSystemsDirName
678 else SystemsDir := GameSystemsDirName;
679 if DirectoryExists(SystemsDir) then begin
680 GameSystems.LoadFromDir(SystemsDir);
681 end else begin
682 // Create default game system if the directory with definitions was not found
683 NewGameSystem := TGameSystem.Create;
684 NewGameSystem.FileName := DefaultGameSystemName;
685 NewUnitKind := TUnitKind.Create;
686 NewUnitKind.Name := 'Unit';
687 NewGameSystem.UnitKinds.Add(NewUnitKind);
688 GameSystems.Add(NewGameSystem);
689 end;
690 if GameSystems.Count > 0 then begin
691 GameSettings.GameSystem.Assign(GameSystems.First);
692 Game.GameSystem.Assign(GameSystems.First);
693 end;
694end;
695
696procedure TCore.ReopenGameOnInit;
697begin
698 CommandLineParams;
699 if not GameLoaded and ReopenLastFile and (LastOpenedList1.Items.Count > 0) and
700 FileExists(LastOpenedList1.Items[0]) then
701 LoadGame(LastOpenedList1.Items[0]);
702
703 if Game.FileName = '' then begin
704 GameSettings.PostConfig;
705 Game.Assign(GameSettings);
706 StartNewGame;
707 end;
708end;
709
710procedure TCore.Spectate(Player: TPlayer);
711var
712 Form: TFormClient;
713begin
714 Form := TFormClient.Create(nil);
715 Form.Client := TClientGUI(LocalClients.New(SSpectator));
716 Form.Client.LocalServer := Server;
717 Form.Client.ConnectType := ctLocal;
718 Form.Client.Active := True;
719 //Form.Client.Form := Form;
720 //Form.Client.ControlPlayer := Player;
721 Form.AZoomAll.Execute;
722 Form.Show;
723 FormClients.Add(Form);
724end;
725
726procedure TCore.StartNewGame;
727var
728 NewClient: TClient;
729 Player: TPlayer;
730 I: Integer;
731 ServerClient: TServerClient;
732begin
733 Game.New;
734 Server.InitClients;
735 Server.Active := True;
736
737 // Create local LocalClients for human players
738 LocalClients.Clear;
739 FormMain.FormClient.Client := nil;
740 for I := 0 to Game.Players.Count - 1 do begin
741 Player := TPlayer(Game.Players[I]);
742 with Player do
743 if Mode = pmHuman then begin
744 NewClient := LocalClients.New(Name);
745 NewClient.ControlPlayer := Player;
746 TClientGUI(NewClient).View.Clear;
747 TClientGUI(NewClient).View.Zoom := 1;
748 NewClient.LocalServer := Server;
749 NewClient.ConnectType := ctLocal;
750 NewClient.Active := True;
751 if Assigned(NewClient.ControlPlayer.StartCell) then
752 TClientGUI(NewClient).View.CenterPlayerCity(NewClient.ControlPlayer)
753 else TClientGUI(NewClient).View.CenterMap;
754 end else
755 if Mode = pmComputer then begin
756 NewClient := TComputer.Create;
757 NewClient.Game := TGame(Game);
758 NewClient.Name := Name;
759 LocalClients.Add(NewClient);
760 NewClient.ControlPlayer := Player;
761 NewClient.LocalServer := Server;
762 NewClient.ConnectType := ctLocal;
763 NewClient.Active := True;
764 end;
765 end;
766
767 Game.DevelMode := DevelMode;
768 SelectClient;
769 if Game.Players.GetAliveCount = Game.Players.Count then Game.Running := True
770 else ShowMessage(Format(SPlayersNotInitialized, [Game.Players.Count, Game.Players.GetAliveCount]));
771 UpdateOtherForms;
772 UpdateInterface;
773 ServerClient := Server.Clients.SearchByPlayer(Game.CurrentPlayer);
774 if Assigned(ServerClient) then ServerClient.TurnStart
775 else raise Exception.Create(SMissingServerClientForPlayer);
776end;
777
778procedure TCore.DoPlayerChange(Sender: TObject);
779var
780 PlayerClient: TClient;
781 ServerClient: TServerClient;
782begin
783 Application.ProcessMessages;
784 Server.NextPlayer;
785 if Assigned(Game.CurrentPlayer) then begin
786 if Game.CurrentPlayer.Mode = pmHuman then begin
787 PlayerClient := LocalClients.SearchPlayer(Game.CurrentPlayer);
788 if Assigned(PlayerClient) then FormMain.FormClient.Client := TClientGUI(PlayerClient);
789 end;
790
791 ServerClient := Server.Clients.SearchByPlayer(Game.CurrentPlayer);
792 if Assigned(ServerClient) then ServerClient.TurnStart;
793 end;
794 UpdateOtherForms;
795end;
796
797procedure TCore.DoMoveUpdated(UnitMove: TUnitMove);
798begin
799 if Assigned(FormMain.FormUnitMoves) and FormMain.FormUnitMoves.Visible then
800 FormMain.FormUnitMoves.ReloadList;
801end;
802
803procedure TCore.Init;
804begin
805 if not Core.Initialized then begin
806 FInitialized := True;
807 LoadGameSystems;
808
809 // Update translated default player names
810 GameSettings.Players[0].Name := SPlayer + ' 1';
811 GameSettings.Players[1].Name := SPlayer + ' 2';
812
813 // GameSystemName needs to be loaded before game systems config itself.
814 // Players reference Nations from game system.
815 GameSettings.GameSystem.Assign(GameSystems.SearchByName(string(XMLConfig1.GetValue(DOMString('Game/GameSystemName'), DOMString('HexWars')))));
816 GameSettings.LoadConfig(XMLConfig1, 'Game');
817 Server.LoadConfig(XMLConfig1, 'Server');
818 ServerList.LoadConfig(XmlConfig1, 'ServerList');
819
820 FormClientActions;
821 end;
822end;
823
824procedure TCore.Done;
825begin
826 SaveConfigAll;
827end;
828
829end.
830
Note: See TracBrowser for help on using the repository browser.