source: trunk/NoTerm.pas

Last change on this file was 731, checked in by chronos, 7 weeks ago
  • Modified: Initialize Log dialog later from Term and NoTerm forms.
File size: 12.6 KB
Line 
1{$INCLUDE Switches.inc}
2unit NoTerm;
3
4interface
5
6uses
7 ScreenTools, Protocol, Messg, LCLIntf, LCLType, DateUtils, Platform,
8 SysUtils, Classes, ButtonB, DrawDlg, Log,
9 {$IFDEF DPI}Dpi.Graphics, Dpi.Controls, Dpi.Forms, Dpi.Common, System.UITypes{$ELSE}
10 Graphics, Controls, Forms{$ENDIF};
11
12type
13 TRunMode = (rmStop, rmStopped, rmRunning, rmQuit);
14
15 { TNoTermDlg }
16
17 TNoTermDlg = class(TDrawDlg)
18 QuitBtn: TButtonB;
19 GoBtn: TButtonB;
20 procedure GoBtnClick(Sender: TObject);
21 procedure QuitBtnClick(Sender: TObject);
22 procedure FormPaint(Sender: TObject);
23 procedure FormCreate(Sender: TObject);
24 procedure FormDestroy(Sender: TObject);
25 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
26 private
27 function GetLogDlg: TLogDlg;
28 public
29 procedure Client(Command, Player: Integer; var Data);
30 private
31 Me: Integer;
32 Active: Integer;
33 ToldAlive: Integer;
34 Round: Integer;
35 LastShowYearTime: TDateTime;
36 LastShowTurnChange: TDateTime;
37 LastNewTurn: TDateTime;
38 TurnTime: Extended;
39 TotalStatTime: Extended;
40 G: TNewGameData;
41 Server: TServerCall;
42 Shade: TBitmap;
43 State: TBitmap;
44 WinStat: array [0 .. nPl - 1] of Integer;
45 ExtStat: array [0 .. nPl - 1] of Integer;
46 AloneStat: array [0 .. nPl - 1] of Integer;
47 DisallowShowActive: array [0 .. nPl - 1] of Boolean;
48 TimeStat: array [0 .. nPl - 1] of Extended;
49 Mode: TRunMode;
50 FLogDlg: TLogDlg;
51 procedure NewStat;
52 procedure EndPlaying;
53 procedure ShowActive(P: Integer; Active: Boolean);
54 procedure ShowYear;
55 property LogDlg: TLogDlg read GetLogDlg;
56 end;
57
58var
59 NoTermDlg: TNoTermDlg;
60
61procedure Client(Command, Player: Integer; var Data); stdcall;
62
63
64implementation
65
66uses
67 GameServer;
68
69{$R *.lfm}
70
71const
72 UpdateInterval = 0.1; // seconds
73 ShowActiveThreshold = 0.05; // seconds
74
75 nPlOffered = 9;
76 x0Brain = 109 + 48 + 23;
77 y0Brain = 124 + 48 + 7 + 16;
78 dxBrain = 128;
79 dyBrain = 128;
80 xBrain: array [0 .. nPlOffered - 1] of Integer = (x0Brain, x0Brain,
81 x0Brain + dxBrain, x0Brain + dxBrain, x0Brain + dxBrain, x0Brain,
82 x0Brain - dxBrain, x0Brain - dxBrain, x0Brain - dxBrain);
83 yBrain: array [0 .. nPlOffered - 1] of Integer = (y0Brain, y0Brain - dyBrain,
84 y0Brain - dyBrain, y0Brain, y0Brain + dyBrain, y0Brain + dyBrain,
85 y0Brain + dyBrain, y0Brain, y0Brain - dyBrain);
86 xActive: array [0 .. nPlOffered - 1] of Integer = (0, 0, 36, 51, 36, 0,
87 -36, -51, -36);
88 yActive: array [0 .. nPlOffered - 1] of Integer = (0, -51, -36, 0, 36, 51,
89 36, 0, -36);
90
91var
92 FormsCreated: Boolean;
93
94procedure TNoTermDlg.FormCreate(Sender: TObject);
95begin
96 BoundsRect := Bounds(Screen.PrimaryMonitor.Left + Screen.PrimaryMonitor.Width - Width - 8,
97 8, Width, Height);
98 Caption := Phrases.Lookup('AIT');
99 Canvas.Brush.Style := TBrushStyle.bsClear;
100 Canvas.Font.Assign(UniFont[ftSmall]);
101 TitleHeight := 36;
102 InitButtons;
103 LastShowYearTime := 0;
104end;
105
106procedure TNoTermDlg.FormDestroy(Sender: TObject);
107begin
108 if Assigned(FLogDlg) then FreeAndNil(FLogDlg);
109end;
110
111procedure TNoTermDlg.NewStat;
112begin
113 Round := 0;
114 FillChar(WinStat, SizeOf(WinStat), 0);
115 FillChar(ExtStat, SizeOf(ExtStat), 0);
116 FillChar(AloneStat, SizeOf(AloneStat), 0);
117 FillChar(TimeStat, SizeOf(TimeStat), 0);
118 TotalStatTime := 0;
119 Mode := rmStop;
120end;
121
122procedure TNoTermDlg.EndPlaying;
123var
124 EndCommand: Integer;
125begin
126 NewStat;
127 if G.RO[Me].Turn > 0 then
128 with TMessgDlg.Create(nil) do
129 try
130 MessgText := Phrases.Lookup('ENDTOUR');
131 Kind := mkYesNo;
132 ShowModal;
133 if ModalResult = mrIgnore then
134 EndCommand := sResign
135 else
136 EndCommand := sBreak;
137 finally
138 Free;
139 end
140 else
141 EndCommand := sResign;
142 Server(EndCommand, Me, 0, nil^);
143end;
144
145procedure TNoTermDlg.ShowActive(P: Integer; Active: Boolean);
146begin
147 if P < nPlOffered then
148 Sprite(Canvas, HGrSystem, x0Brain + 28 + xActive[P],
149 y0Brain + 28 + yActive[P], 8, 8, 81 + 9 * Byte(Active), 16);
150end;
151
152procedure TNoTermDlg.ShowYear;
153begin
154 Fill(State.Canvas, 0, 0, 192, 20, 64, 287 + 138);
155 RisedTextOut(State.Canvas, 0, 0, Format(Phrases.Lookup('AIT_ROUND'), [Round])
156 + ' ' + TurnToString(G.RO[Me].Turn));
157 BitBltCanvas(Canvas, 64, 287 + 138, 192, 20, State.Canvas, 0, 0);
158end;
159
160procedure TNoTermDlg.Client(Command, Player: Integer; var Data);
161var
162 I, X, Y, P: Integer;
163 ActiveDuration: Extended;
164 ShipComplete: Boolean;
165 R: TRect;
166 nowt: TDateTime;
167begin
168 case Command of
169 cDebugMessage:
170 LogDlg.Add(Player, G.RO[0].Turn, PChar(@Data));
171
172 cInitModule:
173 begin
174 Server := TInitModuleData(Data).Server;
175 TInitModuleData(Data).Flags := aiThreaded;
176 Shade := TBitmap.Create;
177 Shade.SetSize(64, 64);
178 for X := 0 to 63 do
179 for Y := 0 to 63 do
180 if Odd(X + Y) then
181 Shade.Canvas.Pixels[X, Y] := $FFFFFF
182 else
183 Shade.Canvas.Pixels[X, Y] := $000000;
184 State := TBitmap.Create;
185 State.SetSize(192, 20);
186 State.Canvas.Brush.Style := TBrushStyle.bsClear;
187 State.Canvas.Font.Assign(UniFont[ftSmall]);
188 NewStat;
189 end;
190
191 cReleaseModule:
192 begin
193 FreeAndNil(Shade);
194 FreeAndNil(State);
195 end;
196
197 cNewGame, cLoadGame:
198 begin
199 Inc(Round);
200 if Mode = rmRunning then
201 begin
202 Invalidate;
203 Update;
204 end
205 else
206 Show;
207 G := TNewGameData(Data);
208 LogDlg.mSlot.Visible := False;
209 LogDlg.Host := nil;
210 ToldAlive := G.RO[Me].Alive;
211 Active := -1;
212 FillChar(DisallowShowActive, SizeOf(DisallowShowActive), 0); // false
213 LastShowTurnChange := 0;
214 LastNewTurn := 0;
215 TurnTime := 1.0;
216 end;
217
218 cBreakGame:
219 begin
220 LogDlg.List.Clear;
221 if Mode <> rmRunning then
222 begin
223 if LogDlg.Visible then
224 LogDlg.Close;
225 Close;
226 end;
227 end;
228
229 cTurn, cResume, cContinue:
230 begin
231 Me := Player;
232 if Active >= 0 then
233 begin
234 ShowActive(Active, False);
235 Active := -1;
236 end; // should not happen
237
238 nowt := NowPrecise;
239 if SecondOf(nowt - LastShowYearTime) >= UpdateInterval then
240 begin
241 ShowYear;
242 LastShowYearTime := nowt;
243 end;
244 TurnTime := SecondOf(nowt - LastNewTurn);
245 LastNewTurn := nowt;
246 if (G.RO[Me].Alive <> ToldAlive) then
247 begin
248 for P := 1 to nPlOffered - 1 do
249 if 1 shl P and (G.RO[Me].Alive xor ToldAlive) <> 0 then
250 begin
251 R := Rect(xBrain[P], yBrain[P] - 16, xBrain[P] + 64,
252 yBrain[P] - 16 + 64);
253 InvalidateRect(Handle, @R, False);
254 end;
255 ToldAlive := G.RO[Me].Alive;
256 end;
257 Application.ProcessMessages;
258 if Mode = rmQuit then
259 EndPlaying
260 else if G.RO[Me].Happened and phGameEnd <> 0 then
261 begin // game ended, update statistics
262 for P := 1 to nPlOffered - 1 do
263 if Assigned(PlayersBrain[P]) then
264 if 1 shl P and G.RO[Me].Alive = 0 then
265 Inc(ExtStat[P]) // extinct
266 else if G.RO[Me].Alive = 1 shl P then
267 Inc(AloneStat[P]) // only player alive
268 else
269 begin // alive but not alone -- check colony ship
270 ShipComplete := True;
271 for I := 0 to nShipPart - 1 do
272 if G.RO[Me].Ship[P].Parts[I] < ShipNeed[I] then begin
273 ShipComplete := False;
274 Break;
275 end;
276 if ShipComplete then
277 Inc(WinStat[P]);
278 end;
279 if Mode = rmRunning then
280 Server(sNextRound, Me, 0, nil^);
281 end
282 else if Mode = rmRunning then
283 Server(sTurn, Me, 0, nil^);
284 if Mode = rmStop then
285 begin
286 GoBtn.ButtonIndex := 22;
287 Mode := rmStopped;
288 end;
289 end;
290
291 cShowTurnChange:
292 begin
293 nowt := NowPrecise;
294 if Active >= 0 then
295 begin
296 ActiveDuration := SecondOf(nowt - LastShowTurnChange);
297 TimeStat[Active] := TimeStat[Active] + ActiveDuration;
298 TotalStatTime := TotalStatTime + ActiveDuration;
299 if not DisallowShowActive[Active] then
300 ShowActive(Active, False);
301 DisallowShowActive[Active] := (ActiveDuration < TurnTime * 0.25) and
302 (ActiveDuration < ShowActiveThreshold);
303 end;
304 LastShowTurnChange := nowt;
305
306 Active := Integer(Data);
307 if (Active >= 0) and not DisallowShowActive[Active] then
308 ShowActive(Active, True);
309 end;
310 end;
311end;
312
313procedure TNoTermDlg.GoBtnClick(Sender: TObject);
314begin
315 if Mode = rmRunning then
316 Mode := rmStop
317 else if Mode = rmStopped then
318 begin
319 Mode := rmRunning;
320 GoBtn.ButtonIndex := 23;
321 GoBtn.Update;
322 Server(sTurn, Me, 0, nil^);
323 end;
324end;
325
326procedure TNoTermDlg.QuitBtnClick(Sender: TObject);
327begin
328 if Mode = rmStopped then EndPlaying
329 else Mode := rmQuit;
330end;
331
332procedure TNoTermDlg.FormPaint(Sender: TObject);
333var
334 I, TimeShare: Integer;
335begin
336 Fill(Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6, 0, 0);
337 Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, $000000, $000000);
338 Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
339 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
340 Frame(Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
341 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
342 Corner(Canvas, 1, 1, 0, MainTexture);
343 Corner(Canvas, ClientWidth - 9, 1, 1, MainTexture);
344 Corner(Canvas, 1, ClientHeight - 9, 2, MainTexture);
345 Corner(Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture);
346 Canvas.Font.Assign(UniFont[ftCaption]);
347 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Caption)) div 2,
348 7, Caption);
349 Canvas.Font.Assign(UniFont[ftSmall]);
350 for I := 1 to nPlOffered - 1 do
351 if Assigned(PlayersBrain[I]) then
352 begin
353 Frame(Canvas, xBrain[I] - 24, yBrain[I] - 8 - 16, xBrain[I] - 24 + 111,
354 yBrain[I] - 8 - 16 + 111, MainTexture.ColorBevelShade,
355 MainTexture.ColorBevelShade);
356 FrameImage(Canvas, PlayersBrain[I].Picture, xBrain[I],
357 yBrain[I] - 16, 64, 64, 0, 0);
358 if 1 shl I and G.RO[Me].Alive = 0 then
359 BitBltCanvas(Canvas, xBrain[I], yBrain[I] - 16, 64, 64,
360 Shade.Canvas, 0, 0, SRCAND);
361 Sprite(Canvas, HGrSystem, xBrain[I] + 30 - 14, yBrain[I] + 53, 14,
362 14, 1, 316);
363 RisedTextOut(Canvas, xBrain[I] + 30 - 16 - BiColorTextWidth(Canvas,
364 IntToStr(WinStat[I])), yBrain[I] + 51, IntToStr(WinStat[I]));
365 Sprite(Canvas, HGrSystem, xBrain[I] + 34, yBrain[I] + 53, 14, 14,
366 1 + 15, 316);
367 RisedTextOut(Canvas, xBrain[I] + 34 + 16, yBrain[I] + 51,
368 IntToStr(AloneStat[I]));
369 Sprite(Canvas, HGrSystem, xBrain[I] + 30 - 14, yBrain[I] + 53 + 16, 14,
370 14, 1 + 30, 316);
371 RisedTextOut(Canvas, xBrain[I] + 30 - 16 - BiColorTextWidth(Canvas,
372 IntToStr(ExtStat[I])), yBrain[I] + 51 + 16, IntToStr(ExtStat[I]));
373 Sprite(Canvas, HGrSystem, xBrain[I] + 34, yBrain[I] + 53 + 16, 14, 14,
374 1 + 45, 316);
375 if TotalStatTime > 0 then
376 begin
377 TimeShare := Trunc(TimeStat[I] / TotalStatTime * 100 + 0.5);
378 RisedTextOut(Canvas, xBrain[I] + 34 + 16, yBrain[I] + 51 + 16,
379 IntToStr(TimeShare) + '%');
380 end;
381 ShowActive(I, I = Active);
382 end;
383 Sprite(Canvas, HGrSystem2, x0Brain + 32 - 20, y0Brain + 32 - 20, 40,
384 40, 115, 1);
385 ShowYear;
386 BtnFrame(Canvas, GoBtn.BoundsRect, MainTexture);
387 BtnFrame(Canvas, QuitBtn.BoundsRect, MainTexture);
388 // BtnFrame(Canvas,StatBtn.BoundsRect,MainTexture);
389end;
390
391procedure Client(Command, Player: Integer; var Data);
392begin
393 if not FormsCreated then
394 begin
395 FormsCreated := True;
396 Application.CreateForm(TNoTermDlg, NoTermDlg);
397 end;
398 NoTermDlg.Client(Command, Player, Data);
399end;
400
401procedure TNoTermDlg.FormKeyDown(Sender: TObject; var Key: Word;
402 Shift: TShiftState);
403begin
404 if (Char(Key) = 'M') and (ssCtrl in Shift) then
405 if LogDlg.Visible then
406 LogDlg.Close
407 else
408 LogDlg.Show;
409end;
410
411function TNoTermDlg.GetLogDlg: TLogDlg;
412begin
413 if not Assigned(FLogDlg) then FLogDlg := TLogDlg.Create(nil);
414 Result := FLogDlg;
415end;
416
417initialization
418
419FormsCreated := False;
420
421end.
Note: See TracBrowser for help on using the repository browser.