source: tags/1.3.4/NoTerm.pas

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