source: trunk/Core.pas

Last change on this file was 414, checked in by chronos, 10 months ago
  • Modified: Lowered idle CPU consumption.
File size: 25.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 MapImagesDir: string;
77 GameSystemsDir: string;
78 procedure LoadRecentExecute(Sender: TObject);
79 procedure StartNewGame;
80 procedure LoadGame(FileName: string);
81 procedure DoPlayerChange(Sender: TObject);
82 procedure DoMoveUpdated(UnitMove: TUnitMove);
83 procedure DoOnWin(Player: TPlayer);
84 procedure Delay(Time: Integer);
85 procedure GameNewTurnExecute(Sender: TObject);
86 procedure CommandLineParams;
87 procedure SelectClient;
88 procedure UpdateOtherForms;
89 procedure FormClientActions;
90 procedure LoadGameSystems;
91 function GetAutoSaveFileName: string;
92 public
93 Game: TGame;
94 GameSettings: TGame;
95 Server: TServer;
96 UseSingleView: Boolean;
97 DevelMode: Boolean;
98 AnimationSpeed: Integer;
99 CellGridVisible: Boolean;
100 UnitShapeVisible: Boolean;
101 FormClients: TFormClients;
102 LocalClients: TClients;
103 ServerList: TServerList;
104 GameSystems: TGameSystems;
105 FormMain: TFormMain;
106 procedure AutoSave;
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 AutoSaveFileName = 'AutoSave' + GameFileExt;
139 GameSystemsDirName = 'Systems';
140 LanguagesDirName = 'Languages';
141 MapImagesDirName = 'Images' + DirectorySeparator + 'Maps';
142 DefaultGameSystemName = 'Default';
143
144resourcestring
145 SPlayerWins = 'Player %s wins';
146 SPlayersWins = 'Players %s win';
147 SEndGame = 'End game?';
148 SEndGameQuestion = 'Do you want to end current game?';
149 SRestartGame = 'Restart game?';
150 SRestartGameQuestion = 'Do you want to restart current game?';
151 SPlayersNotInitialized = 'Not all players were initialized with start cell. Needed %d, initialized %d. Change map parameters to have more terrain cells.';
152 SFileDialogFilter = 'xTactics games (' + GameFileExt + ')|*' + GameFileExt + '|All files|*.*';
153 SMissingServerClientForPlayer = 'Server client for current player not found.';
154
155procedure Translate;
156begin
157 Game.InitStrings;
158end;
159
160{ TCore }
161
162procedure TCore.DoOnWin(Player: TPlayer);
163var
164 PlayerNames: string;
165 AlivePlayers: TPlayerArray;
166 I: Integer;
167begin
168 Server.GameEnd;
169 if Assigned(Player) then
170 ShowMessage(Format(SPlayerWins, [Player.Name]))
171 else begin
172 AlivePlayers := Game.Players.GetAlivePlayers;
173 PlayerNames := '';
174 for I := 0 to Length(AlivePlayers) - 1 do begin
175 if I > 0 then PlayerNames := PlayerNames + ', ';
176 PlayerNames := PlayerNames + AlivePlayers[I].Name;
177 end;
178 ShowMessage(Format(SPlayersWins, [PlayerNames]))
179 end;
180end;
181
182procedure TCore.Delay(Time: Integer);
183const
184 Slice = 50; // ms
185begin
186 while Time > 0 do begin
187 Application.ProcessMessages;
188 if Time > Slice then Sleep(Slice) else Sleep(Time);
189 Dec(Time, Slice);
190 end;
191end;
192
193procedure TCore.GameNewTurnExecute(Sender: TObject);
194begin
195 AutoSave;
196end;
197
198procedure TCore.AutoSave;
199var
200 OldFileName: string;
201begin
202 OldFileName := Game.FileName;
203 Game.SaveToFile(GetAutoSaveFileName);
204 Game.FileName := OldFileName;
205end;
206
207procedure TCore.LoadConfig;
208begin
209 RegistryContext := TRegistryContext.Create(HKEY_CURRENT_USER, DefaultRegKey);
210 PersistentForm1.RegistryContext := RegistryContext;
211 XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';
212
213 ThemeManager1.Theme := ThemeManager1.Themes.FindByName(String(XmlConfig1.GetValue('Theme', 'System')));
214 LastOpenedList1.LoadFromXMLConfig(XMLConfig1, 'RecentFiles');
215 DevelMode := XMLConfig1.GetValue('DevelMode', False);
216 AnimationSpeed := XMLConfig1.GetValue('AnimationSpeed', 50);
217 Translator1.Language := Translator1.Languages.SearchByCode(String(XMLConfig1.GetValue('Language', '')));
218 ScaleDPI1.DPI := Point(XMLConfig1.GetValue('DPIX', 96), XMLConfig1.GetValue('DPIY', 96));
219 ScaleDPI1.AutoDetect := XMLConfig1.GetValue('DPIAuto', True);
220 FormNewTabIndex := XMLConfig1.GetValue('FormNewTabIndex', 0);
221 CellGridVisible := XMLConfig1.GetValue('CellGridVisible', True);
222 UnitShapeVisible := XMLConfig1.GetValue('UnitShapeVisible', False);
223end;
224
225procedure TCore.SaveConfig;
226begin
227 XMLConfig1.SetValue('Language', WideString(Translator1.Language.Code));
228 XMLConfig1.SetValue('Theme', WideString(ThemeManager1.Theme.Name));
229 LastOpenedList1.SaveToXMLConfig(XMLConfig1, 'RecentFiles');
230 XMLConfig1.SetValue('DevelMode', DevelMode);
231 XMLConfig1.SetValue('AnimationSpeed', AnimationSpeed);
232 XMLConfig1.SetValue('DPIX', ScaleDPI1.DPI.X);
233 XMLConfig1.SetValue('DPIY', ScaleDPI1.DPI.Y);
234 XMLConfig1.SetValue('DPIAuto', ScaleDPI1.AutoDetect);
235 XMLConfig1.SetValue('FormNewTabIndex', FormNewTabIndex);
236 XMLConfig1.SetValue('CellGridVisible', CellGridVisible);
237 XMLConfig1.SetValue('UnitShapeVisible', UnitShapeVisible);
238end;
239
240procedure TCore.SaveConfigAll;
241begin
242 GameSettings.SaveConfig(XMLConfig1, 'Game');
243 Server.SaveConfig(XMLConfig1, 'Server');
244 ServerList.SaveConfig(XmlConfig1, 'ServerList');
245 SaveConfig;
246 XMLConfig1.Flush;
247end;
248
249procedure TCore.CommandLineParams;
250var
251 FileName: string;
252begin
253 // Command line parameter handling
254 if (ParamCount > 0) then begin
255 FileName := ParamStr(1);
256 if FileExists(FileName) then LoadGame(FileName);
257 end;
258end;
259
260procedure TCore.ScaleDPI;
261var
262 I: Integer;
263begin
264 //{$ifdef DEBUG}
265 with Core.ScaleDPI1 do begin
266 //DesignDPI := Point(144, 144);
267 if (DesignDPI.X <> DPI.X) or (DesignDPI.Y <> DPI.Y) then begin
268 //ApplyToAll(DesignDPI);
269 for I := 0 to Screen.FormCount - 1 do
270 if (Screen.Forms[I].WindowState = wsNormal) or
271 (Screen.Forms[I].WindowState = wsMinimized) then begin
272 StoreDimensions(Screen.Forms[I], StoredDimension);
273 ScaleDimensions(Screen.Forms[I], StoredDimension);
274 end;
275 ScaleImageList(Core.ImageListSmall, DesignDPI);
276 ScaleImageList(Core.ImageListLarge, DesignDPI);
277 end;
278 end;
279 //{$endif}
280end;
281
282procedure TCore.SelectClient;
283begin
284 if not Assigned(Game.CurrentPlayer) then
285 Game.CurrentPlayer := Game.Players.GetFirstHuman;
286 if Assigned(Game.CurrentPlayer) and (Game.CurrentPlayer.Mode = pmHuman) then begin
287 FormMain.FormClient.Client := TClientGUI(LocalClients.SearchPlayer(Game.CurrentPlayer));
288 end else begin
289 FormMain.FormClient.Client := TClientGUI(LocalClients.New(SSpectator));
290 FormMain.FormClient.Client.LocalServer := Server;
291 FormMain.FormClient.Client.ConnectType := ctLocal;
292 FormMain.FormClient.Client.Active := True;
293 FormMain.FormClient.AZoomAll.Execute;
294 end;
295end;
296
297procedure TCore.UpdateInterface;
298begin
299 AGameEnd.Enabled := Game.Running;
300 AFullscreen.Checked := FormMain.FullScreen;
301 {$IFDEF DEBUG}
302 ATests.Visible := True;
303 ATests.Enabled := True;
304 {$ELSE}
305 ATests.Visible := False;
306 ATests.Enabled := False;
307 {$ENDIF}
308end;
309
310procedure TCore.AExitExecute(Sender: TObject);
311begin
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.Assign(NewServer.Game);
372 GameSettings.Assign(NewServer.Game);
373 SaveConfigAll;
374 StartNewGame;
375 GameLoaded := False;
376 end;
377 FormNewTabIndex := FormNew.PageControl1.TabIndex;
378 NewServer.Game.Free;
379 NewServer.Game := nil;
380 NewServer.Free;
381 finally
382 FormNew.Free;
383 end;
384end;
385
386procedure TCore.AGameRestartExecute(Sender: TObject);
387begin
388 if MessageDlg(SRestartGame, SRestartGameQuestion, mtConfirmation, mbYesNo, 0) = mrYes then begin
389 StartNewGame;
390 end;
391end;
392
393procedure TCore.AGameSaveAsExecute(Sender: TObject);
394begin
395 SaveDialog1.Filter := SFileDialogFilter;
396 SaveDialog1.InitialDir := ExtractFileDir(Game.FileName);
397 SaveDialog1.FileName := ExtractFileName(Game.FileName);
398 if SaveDialog1.Execute then begin
399 Game.SaveToFile(SaveDialog1.FileName);
400 LastOpenedList1.AddItem(SaveDialog1.FileName);
401 end;
402end;
403
404procedure TCore.AGameSaveExecute(Sender: TObject);
405begin
406 if FileExists(Game.FileName) then
407 Game.SaveToFile(Game.FileName)
408 else AGameSaveAs.Execute;
409end;
410
411procedure TCore.AGameSystemsExecute(Sender: TObject);
412var
413 FormGameSystems: TFormGameSystems;
414begin
415 FormGameSystems := TFormGameSystems.Create(nil);
416 try
417 FormGameSystems.GameSystems := GameSystems;
418 FormGameSystems.ShowModal;
419 finally
420 FreeAndNil(FormGameSystems);
421 end;
422end;
423
424procedure TCore.AHelpExecute(Sender: TObject);
425var
426 FormHelp: TFormHelp;
427begin
428 FormHelp := TFormHelp.Create(Self);
429 try
430 FormHelp.ShowModal;
431 finally
432 FreeAndNil(FormHelp);
433 end;
434end;
435
436procedure TCore.ANewSpectatorClientExecute(Sender: TObject);
437begin
438 Spectate(nil);
439end;
440
441procedure TCore.APlayersStatsExecute(Sender: TObject);
442begin
443 if not Assigned(FormMain.FormPlayersStats) then
444 FormMain.FormPlayersStats := TFormPlayersStats.Create(nil);
445 FormMain.FormPlayersStats.OnSpectate := Spectate;
446 FormMain.FormPlayersStats.Game := Game;
447 FormMain.FormPlayersStats.Show;
448end;
449
450procedure TCore.ASettingsExecute(Sender: TObject);
451var
452 FormSettings: TFormSettings;
453begin
454 FormSettings := TFormSettings.Create(nil);
455 try
456 FormSettings.Load;
457 if FormSettings.ShowModal = mrOk then begin
458 FormSettings.Save;
459 Game.SaveConfig(XMLConfig1, 'Game');
460 Server.SaveConfig(XMLConfig1, 'Server');
461 XMLConfig1.Flush;
462 ThemeManager1.UseTheme(FormMain);
463 end;
464 finally
465 FreeAndNil(FormSettings);
466 end;
467end;
468
469procedure TCore.AShowChartsExecute(Sender: TObject);
470begin
471 if not Assigned(FormMain.FormCharts) then
472 FormMain.FormCharts := TFormCharts.Create(nil);
473 FormMain.FormCharts.Game := Game;
474 FormMain.FormCharts.Show;
475end;
476
477procedure TCore.AShowKeyShortcutsExecute(Sender: TObject);
478begin
479 if not Assigned(FormMain.FormKeyShortcuts) then
480 FormMain.FormKeyShortcuts := TFormKeyShortcuts.Create(nil);
481 with FormMain.FormKeyShortcuts do begin
482 Images := ImageListSmall;
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.TestCases.Free;
506 FormTests.TestCases := nil;
507 FormTests.Free;
508end;
509
510procedure TCore.AToggleFogOfWarExecute(Sender: TObject);
511begin
512 Game.FogOfWar := not Game.FogOfWar;
513 Server.DoChange(Self);
514end;
515
516procedure TCore.Translator1Translate(Sender: TObject);
517begin
518 Translate;
519 if Assigned(FormMain) then
520 Translator1.TranslateComponentRecursive(FormMain.FormClient);
521end;
522
523procedure TCore.DataModuleCreate(Sender: TObject);
524var
525 BaseDir: string;
526{$IFDEF UNIX}
527const
528 LinuxRelativeDir = '../share/xtactics';
529var
530 NewDir: string;
531{$ENDIF}
532begin
533 Randomize;
534
535 BaseDir := ExcludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
536 GameSystemsDir := CombinePaths(BaseDir, GameSystemsDirName);
537 MapImagesDir := CombinePaths(BaseDir, MapImagesDirName);
538 Translator1.POFilesFolder := CombinePaths(BaseDir, LanguagesDirName);
539
540 {$IFDEF UNIX}
541 // If installed in Linux system then use installation shared game directory for game systems
542 if not DirectoryExists(GameSystemsDir) then begin
543 NewDir := ExpandFileName(BaseDir + DirectorySeparator + LinuxRelativeDir +
544 DirectorySeparator + GameSystemsDirName);
545 if DirectoryExists(NewDir) then GameSystemsDir := NewDir;
546 end;
547
548 // If installed in Linux system then use installation shared game directory for map images
549 if not DirectoryExists(MapImagesDir) then begin
550 NewDir := ExpandFileName(BaseDir + DirectorySeparator + LinuxRelativeDir +
551 DirectorySeparator + MapImagesDirName);
552 if DirectoryExists(NewDir) then MapImagesDir := NewDir;
553 end;
554
555 // If installed in Linux system then use installation directory for po files
556 if not DirectoryExists(Translator1.POFilesFolder) then begin
557 NewDir := ExpandFileName(BaseDir + DirectorySeparator + LinuxRelativeDir +
558 DirectorySeparator + LanguagesDirName);
559 if DirectoryExists(NewDir) then Translator1.POFilesFolder := NewDir;
560 end;
561 {$ENDIF}
562
563 GameSystems := TGameSystems.Create;
564 Server := TServer.Create;
565 LocalClients := TClients.Create;
566 GameSettings := TGame.Create;
567 GameSettings.FileName := 'Settings';
568 GameSettings.MapImageFileName := MapImagesDir + DirectorySeparator + 'WorldMap.png';
569 Game := TGame.Create;
570 Game.OnMoveUpdated := DoMoveUpdated;
571 Game.OnWin := DoOnWin;
572 Game.OnNewTurn := GameNewTurnExecute;
573 Game.OnPlayerChange := DoPlayerChange;
574 Server.Game := Game;
575 LocalClients.Game := Game;
576 StoredDimension := TControlDimension.Create;
577 XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';
578 ForceDirectories(GetAppConfigDir(False));
579 FormClients := TFormClients.Create;
580 ServerList := TServerList.Create;
581
582 LoadConfig;
583
584 TFormEx.ScaleDPI := ScaleDPI1;
585 TFormEx.Translator := Translator1;
586 TFormEx.ThemeManager := ThemeManager1;
587 TFormEx.PersistentForm := PersistentForm1;
588
589 Application.CreateForm(TFormMain, FormMain);
590 FormMain.Show;
591end;
592
593procedure TCore.DataModuleDestroy(Sender: TObject);
594begin
595 FreeAndNil(ServerList);
596 FreeAndNil(FormClients);
597 FreeAndNil(StoredDimension);
598 FreeAndNil(Server);
599 FreeAndNil(LocalClients);
600 FreeAndNil(Game);
601 FreeAndNil(GameSettings);
602 FreeAndNil(GameSystems);
603end;
604
605procedure TCore.LastOpenedList1Change(Sender: TObject);
606begin
607 if Assigned(FormMain) then begin
608 LastOpenedList1.LoadToMenuItem(FormMain.MenuItemLoadRecent, LoadRecentExecute);
609 LastOpenedList1.LoadToMenuItem(FormMain.PopupMenuOpenRecent.Items, LoadRecentExecute);
610 end;
611end;
612
613procedure TCore.LoadRecentExecute(Sender: TObject);
614begin
615 LoadGame((Sender as TMenuItem).Caption);
616end;
617
618procedure TCore.LoadGame(FileName: string);
619var
620 I: Integer;
621 NewClient: TClient;
622 ServerClient: TServerClient;
623 Player: TPlayer;
624begin
625 GameLoaded := True;
626
627 Game.LoadFromFile(FileName);
628 Server.InitClients;
629 Server.Active := True;
630
631 // Create local LocalClients for human players
632 LocalClients.Clear;
633 FormMain.FormClient.Client := nil;
634 for I := 0 to Game.Players.Count - 1 do begin
635 Player := Game.Players[I];
636 with Player do
637 if Mode = pmHuman then begin
638 NewClient := LocalClients.New(Name);
639 NewClient.ControlPlayer := Player;
640 TClientGUI(NewClient).View.Clear;
641 TClientGUI(NewClient).View.Zoom := 1;
642 NewClient.LocalServer := Server;
643 NewClient.ConnectType := ctLocal;
644 NewClient.Active := True;
645 if Assigned(NewClient.ControlPlayer.StartCell) then
646 TClientGUI(NewClient).View.CenterPlayerCity(NewClient.ControlPlayer)
647 else TClientGUI(NewClient).View.CenterMap;
648 end else
649 if Mode = pmComputer then begin
650 NewClient := TComputer.Create;
651 NewClient.Game := TGame(Game);
652 NewClient.Name := Name;
653 LocalClients.Add(NewClient);
654 NewClient.ControlPlayer := Player;
655 NewClient.LocalServer := Server;
656 NewClient.ConnectType := ctLocal;
657 NewClient.Active := True;
658 end;
659 end;
660
661 SelectClient;
662 LastOpenedList1.AddItem(FileName);
663 UpdateOtherForms;
664 UpdateInterface;
665 ServerClient := Server.Clients.SearchByPlayer(Game.CurrentPlayer);
666 if Assigned(ServerClient) then ServerClient.TurnStart
667 else raise Exception.Create(SMissingServerClientForPlayer);
668end;
669
670procedure TCore.UpdateOtherForms;
671begin
672 if Assigned(FormMain.FormCharts) and FormMain.FormCharts.Visible then
673 FormMain.FormCharts.Redraw;
674 if Assigned(FormMain.FormUnitMoves) and FormMain.FormUnitMoves.Visible then
675 FormMain.FormUnitMoves.ReloadList;
676 if Assigned(FormMain.FormPlayersStats) and FormMain.FormPlayersStats.Visible then
677 FormMain.FormPlayersStats.ReloadList;
678end;
679
680procedure TCore.FormClientActions;
681var
682 Action: TAction;
683 I: Integer;
684begin
685 // Copy all actions from docked form to main form so keyboard shortcuts will be active
686 for I := 0 to FormMain.FormClient.ActionList1.ActionCount - 1 do begin
687 Action := TAction.Create(FormMain);
688 Action.Assign(TAction(FormMain.FormClient.ActionList1.Actions[I]));
689 Action.ActionList := FormMain.ActionList1;
690 end;
691end;
692
693procedure TCore.LoadGameSystems;
694var
695 NewGameSystem: TGameSystem;
696 NewUnitKind: TUnitKind;
697begin
698 if DirectoryExists(GameSystemsDir) then begin
699 GameSystems.LoadFromDir(GameSystemsDir);
700 end else begin
701 // Create default game system if the directory with definitions was not found
702 NewGameSystem := TGameSystem.Create;
703 NewGameSystem.FileName := DefaultGameSystemName;
704 NewUnitKind := TUnitKind.Create;
705 NewUnitKind.Name := 'Unit';
706 NewUnitKind.Moves := 1;
707 NewUnitKind.Power := 99;
708 NewGameSystem.UnitKinds.Add(NewUnitKind);
709 GameSystems.Add(NewGameSystem);
710 end;
711 if GameSystems.Count > 0 then begin
712 GameSettings.GameSystem.Assign(GameSystems.First);
713 Game.GameSystem.Assign(GameSystems.First);
714 end;
715end;
716
717function TCore.GetAutoSaveFileName: string;
718begin
719 Result := GetAppConfigDir(False) + AutoSaveFileName;
720end;
721
722procedure TCore.ReopenGameOnInit;
723var
724 OldFileName: string;
725begin
726 CommandLineParams;
727
728 if not GameLoaded and FileExists(GetAutoSaveFileName) then begin
729 OldFileName := Game.FileName;
730 LoadGame(GetAutoSaveFileName);
731 LastOpenedList1.Items.Delete(0);
732 Game.FileName := OldFileName;
733 end;
734
735 if not GameLoaded and (Game.FileName = '') then begin
736 Game.Assign(GameSettings);
737 StartNewGame;
738 end;
739end;
740
741procedure TCore.Spectate(Player: TPlayer);
742var
743 Form: TFormClient;
744begin
745 Form := TFormClient.Create(nil);
746 Form.Client := TClientGUI(LocalClients.New(SSpectator));
747 Form.Client.LocalServer := Server;
748 Form.Client.ConnectType := ctLocal;
749 Form.Client.Active := True;
750 //Form.Client.Form := Form;
751 //Form.Client.ControlPlayer := Player;
752 Form.AZoomAll.Execute;
753 Form.Show;
754 FormClients.Add(Form);
755end;
756
757procedure TCore.StartNewGame;
758var
759 NewClient: TClient;
760 Player: TPlayer;
761 I: Integer;
762 ServerClient: TServerClient;
763begin
764 Game.New;
765 Server.InitClients;
766 Server.Active := True;
767
768 // Create local LocalClients for human players
769 LocalClients.Clear;
770 FormMain.FormClient.Client := nil;
771 for I := 0 to Game.Players.Count - 1 do begin
772 Player := Game.Players[I];
773 with Player do
774 if Mode = pmHuman then begin
775 NewClient := LocalClients.New(Name);
776 NewClient.ControlPlayer := Player;
777 TClientGUI(NewClient).View.Clear;
778 TClientGUI(NewClient).View.Zoom := 1;
779 NewClient.LocalServer := Server;
780 NewClient.ConnectType := ctLocal;
781 NewClient.Active := True;
782 if Assigned(NewClient.ControlPlayer.StartCell) then
783 TClientGUI(NewClient).View.CenterPlayerCity(NewClient.ControlPlayer)
784 else TClientGUI(NewClient).View.CenterMap;
785 end else
786 if Mode = pmComputer then begin
787 NewClient := TComputer.Create;
788 NewClient.Game := TGame(Game);
789 NewClient.Name := Name;
790 LocalClients.Add(NewClient);
791 NewClient.ControlPlayer := Player;
792 NewClient.LocalServer := Server;
793 NewClient.ConnectType := ctLocal;
794 NewClient.Active := True;
795 end;
796 end;
797
798 Game.DevelMode := DevelMode;
799 SelectClient;
800 if Game.Players.GetAliveCount = Game.Players.Count then Game.Running := True
801 else ShowMessage(Format(SPlayersNotInitialized, [Game.Players.Count, Game.Players.GetAliveCount]));
802 UpdateOtherForms;
803 UpdateInterface;
804 ServerClient := Server.Clients.SearchByPlayer(Game.CurrentPlayer);
805 if Assigned(ServerClient) then ServerClient.TurnStart
806 else raise Exception.Create(SMissingServerClientForPlayer);
807end;
808
809procedure TCore.DoPlayerChange(Sender: TObject);
810var
811 PlayerClient: TClient;
812 ServerClient: TServerClient;
813begin
814 Application.ProcessMessages;
815 Server.NextPlayer;
816 if Assigned(Game.CurrentPlayer) then begin
817 if Game.CurrentPlayer.Mode = pmHuman then begin
818 PlayerClient := LocalClients.SearchPlayer(Game.CurrentPlayer);
819 if Assigned(PlayerClient) then FormMain.FormClient.Client := TClientGUI(PlayerClient);
820 end;
821
822 ServerClient := Server.Clients.SearchByPlayer(Game.CurrentPlayer);
823 if Assigned(ServerClient) then ServerClient.TurnStart;
824 end;
825 UpdateOtherForms;
826end;
827
828procedure TCore.DoMoveUpdated(UnitMove: TUnitMove);
829begin
830 if Assigned(FormMain.FormUnitMoves) and FormMain.FormUnitMoves.Visible then
831 FormMain.FormUnitMoves.ReloadList;
832end;
833
834procedure TCore.Init;
835var
836 GameSystem: TGameSystem;
837begin
838 if not Core.Initialized then begin
839 FInitialized := True;
840 LoadGameSystems;
841
842 // Update translated default player names
843 GameSettings.Players[0].Name := SPlayer + ' 1';
844 GameSettings.Players[1].Name := SPlayer + ' 2';
845
846 // GameSystemName needs to be loaded before game systems config itself.
847 // Players reference Nations from game system.
848 GameSystem := GameSystems.SearchByName(string(XMLConfig1.GetValue(DOMString('Game/GameSystemName'), DOMString('HexWars'))));
849 if Assigned(GameSystem) then GameSettings.GameSystem.Assign(GameSystem);
850 GameSettings.LoadConfig(XMLConfig1, 'Game');
851 Server.LoadConfig(XMLConfig1, 'Server');
852 ServerList.LoadConfig(XmlConfig1, 'ServerList');
853
854 FormClientActions;
855 end;
856end;
857
858procedure TCore.Done;
859begin
860 SaveConfigAll;
861end;
862
863end.
864
Note: See TracBrowser for help on using the repository browser.