source: tags/1.3.9/NoTerm.pas

Last change on this file was 725, checked in by chronos, 3 weeks ago
File size: 12.2 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, Dpi.Common, 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 BoundsRect := Bounds(Screen.PrimaryMonitor.Left + Screen.PrimaryMonitor.Width - Width - 8,
90 8, Width, Height);
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 TMessgDlg.Create(nil) do
117 try
118 MessgText := Phrases.Lookup('ENDTOUR');
119 Kind := mkYesNo;
120 ShowModal;
121 if ModalResult = mrIgnore then
122 EndCommand := sResign
123 else
124 EndCommand := sBreak;
125 finally
126 Free;
127 end
128 else
129 EndCommand := sResign;
130 Server(EndCommand, Me, 0, nil^);
131end;
132
133procedure TNoTermDlg.ShowActive(P: Integer; Active: Boolean);
134begin
135 if P < nPlOffered then
136 Sprite(Canvas, HGrSystem, x0Brain + 28 + xActive[P],
137 y0Brain + 28 + yActive[P], 8, 8, 81 + 9 * Byte(Active), 16);
138end;
139
140procedure TNoTermDlg.ShowYear;
141begin
142 Fill(State.Canvas, 0, 0, 192, 20, 64, 287 + 138);
143 RisedTextOut(State.Canvas, 0, 0, Format(Phrases.Lookup('AIT_ROUND'), [Round])
144 + ' ' + TurnToString(G.RO[Me].Turn));
145 BitBltCanvas(Canvas, 64, 287 + 138, 192, 20, State.Canvas, 0, 0);
146end;
147
148procedure TNoTermDlg.Client(Command, Player: Integer; var Data);
149var
150 I, X, Y, P: Integer;
151 ActiveDuration: Extended;
152 ShipComplete: Boolean;
153 R: TRect;
154 nowt: TDateTime;
155begin
156 case Command of
157 cDebugMessage:
158 LogDlg.Add(Player, G.RO[0].Turn, PChar(@Data));
159
160 cInitModule:
161 begin
162 Server := TInitModuleData(Data).Server;
163 TInitModuleData(Data).Flags := aiThreaded;
164 Shade := TBitmap.Create;
165 Shade.SetSize(64, 64);
166 for X := 0 to 63 do
167 for Y := 0 to 63 do
168 if Odd(X + Y) then
169 Shade.Canvas.Pixels[X, Y] := $FFFFFF
170 else
171 Shade.Canvas.Pixels[X, Y] := $000000;
172 State := TBitmap.Create;
173 State.SetSize(192, 20);
174 State.Canvas.Brush.Style := TBrushStyle.bsClear;
175 State.Canvas.Font.Assign(UniFont[ftSmall]);
176 NewStat;
177 end;
178
179 cReleaseModule:
180 begin
181 FreeAndNil(Shade);
182 FreeAndNil(State);
183 end;
184
185 cNewGame, cLoadGame:
186 begin
187 Inc(Round);
188 if Mode = rmRunning then
189 begin
190 Invalidate;
191 Update;
192 end
193 else
194 Show;
195 G := TNewGameData(Data);
196 LogDlg.mSlot.Visible := False;
197 LogDlg.Host := nil;
198 ToldAlive := G.RO[Me].Alive;
199 Active := -1;
200 FillChar(DisallowShowActive, SizeOf(DisallowShowActive), 0); // false
201 LastShowTurnChange := 0;
202 LastNewTurn := 0;
203 TurnTime := 1.0;
204 end;
205
206 cBreakGame:
207 begin
208 LogDlg.List.Clear;
209 if Mode <> rmRunning then
210 begin
211 if LogDlg.Visible then
212 LogDlg.Close;
213 Close;
214 end;
215 end;
216
217 cTurn, cResume, cContinue:
218 begin
219 Me := Player;
220 if Active >= 0 then
221 begin
222 ShowActive(Active, False);
223 Active := -1;
224 end; // should not happen
225
226 nowt := NowPrecise;
227 if SecondOf(nowt - LastShowYearTime) >= UpdateInterval then
228 begin
229 ShowYear;
230 LastShowYearTime := nowt;
231 end;
232 TurnTime := SecondOf(nowt - LastNewTurn);
233 LastNewTurn := nowt;
234 if (G.RO[Me].Alive <> ToldAlive) then
235 begin
236 for P := 1 to nPlOffered - 1 do
237 if 1 shl P and (G.RO[Me].Alive xor ToldAlive) <> 0 then
238 begin
239 R := Rect(xBrain[P], yBrain[P] - 16, xBrain[P] + 64,
240 yBrain[P] - 16 + 64);
241 InvalidateRect(Handle, @R, False);
242 end;
243 ToldAlive := G.RO[Me].Alive;
244 end;
245 Application.ProcessMessages;
246 if Mode = rmQuit then
247 EndPlaying
248 else if G.RO[Me].Happened and phGameEnd <> 0 then
249 begin // game ended, update statistics
250 for P := 1 to nPlOffered - 1 do
251 if Assigned(PlayersBrain[P]) then
252 if 1 shl P and G.RO[Me].Alive = 0 then
253 Inc(ExtStat[P]) // extinct
254 else if G.RO[Me].Alive = 1 shl P then
255 Inc(AloneStat[P]) // only player alive
256 else
257 begin // alive but not alone -- check colony ship
258 ShipComplete := True;
259 for I := 0 to nShipPart - 1 do
260 if G.RO[Me].Ship[P].Parts[I] < ShipNeed[I] then begin
261 ShipComplete := False;
262 Break;
263 end;
264 if ShipComplete then
265 Inc(WinStat[P]);
266 end;
267 if Mode = rmRunning then
268 Server(sNextRound, Me, 0, nil^);
269 end
270 else if Mode = rmRunning then
271 Server(sTurn, Me, 0, nil^);
272 if Mode = rmStop then
273 begin
274 GoBtn.ButtonIndex := 22;
275 Mode := rmStopped;
276 end;
277 end;
278
279 cShowTurnChange:
280 begin
281 nowt := NowPrecise;
282 if Active >= 0 then
283 begin
284 ActiveDuration := SecondOf(nowt - LastShowTurnChange);
285 TimeStat[Active] := TimeStat[Active] + ActiveDuration;
286 TotalStatTime := TotalStatTime + ActiveDuration;
287 if not DisallowShowActive[Active] then
288 ShowActive(Active, False);
289 DisallowShowActive[Active] := (ActiveDuration < TurnTime * 0.25) and
290 (ActiveDuration < ShowActiveThreshold);
291 end;
292 LastShowTurnChange := nowt;
293
294 Active := Integer(Data);
295 if (Active >= 0) and not DisallowShowActive[Active] then
296 ShowActive(Active, True);
297 end;
298 end;
299end;
300
301procedure TNoTermDlg.GoBtnClick(Sender: TObject);
302begin
303 if Mode = rmRunning then
304 Mode := rmStop
305 else if Mode = rmStopped then
306 begin
307 Mode := rmRunning;
308 GoBtn.ButtonIndex := 23;
309 GoBtn.Update;
310 Server(sTurn, Me, 0, nil^);
311 end;
312end;
313
314procedure TNoTermDlg.QuitBtnClick(Sender: TObject);
315begin
316 if Mode = rmStopped then EndPlaying
317 else Mode := rmQuit;
318end;
319
320procedure TNoTermDlg.FormPaint(Sender: TObject);
321var
322 I, TimeShare: Integer;
323begin
324 Fill(Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6, 0, 0);
325 Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, $000000, $000000);
326 Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
327 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
328 Frame(Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
329 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
330 Corner(Canvas, 1, 1, 0, MainTexture);
331 Corner(Canvas, ClientWidth - 9, 1, 1, MainTexture);
332 Corner(Canvas, 1, ClientHeight - 9, 2, MainTexture);
333 Corner(Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture);
334 Canvas.Font.Assign(UniFont[ftCaption]);
335 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Caption)) div 2,
336 7, Caption);
337 Canvas.Font.Assign(UniFont[ftSmall]);
338 for I := 1 to nPlOffered - 1 do
339 if Assigned(PlayersBrain[I]) then
340 begin
341 Frame(Canvas, xBrain[I] - 24, yBrain[I] - 8 - 16, xBrain[I] - 24 + 111,
342 yBrain[I] - 8 - 16 + 111, MainTexture.ColorBevelShade,
343 MainTexture.ColorBevelShade);
344 FrameImage(Canvas, PlayersBrain[I].Picture, xBrain[I],
345 yBrain[I] - 16, 64, 64, 0, 0);
346 if 1 shl I and G.RO[Me].Alive = 0 then
347 BitBltCanvas(Canvas, xBrain[I], yBrain[I] - 16, 64, 64,
348 Shade.Canvas, 0, 0, SRCAND);
349 Sprite(Canvas, HGrSystem, xBrain[I] + 30 - 14, yBrain[I] + 53, 14,
350 14, 1, 316);
351 RisedTextOut(Canvas, xBrain[I] + 30 - 16 - BiColorTextWidth(Canvas,
352 IntToStr(WinStat[I])), yBrain[I] + 51, IntToStr(WinStat[I]));
353 Sprite(Canvas, HGrSystem, xBrain[I] + 34, yBrain[I] + 53, 14, 14,
354 1 + 15, 316);
355 RisedTextOut(Canvas, xBrain[I] + 34 + 16, yBrain[I] + 51,
356 IntToStr(AloneStat[I]));
357 Sprite(Canvas, HGrSystem, xBrain[I] + 30 - 14, yBrain[I] + 53 + 16, 14,
358 14, 1 + 30, 316);
359 RisedTextOut(Canvas, xBrain[I] + 30 - 16 - BiColorTextWidth(Canvas,
360 IntToStr(ExtStat[I])), yBrain[I] + 51 + 16, IntToStr(ExtStat[I]));
361 Sprite(Canvas, HGrSystem, xBrain[I] + 34, yBrain[I] + 53 + 16, 14, 14,
362 1 + 45, 316);
363 if TotalStatTime > 0 then
364 begin
365 TimeShare := Trunc(TimeStat[I] / TotalStatTime * 100 + 0.5);
366 RisedTextOut(Canvas, xBrain[I] + 34 + 16, yBrain[I] + 51 + 16,
367 IntToStr(TimeShare) + '%');
368 end;
369 ShowActive(I, I = Active);
370 end;
371 Sprite(Canvas, HGrSystem2, x0Brain + 32 - 20, y0Brain + 32 - 20, 40,
372 40, 115, 1);
373 ShowYear;
374 BtnFrame(Canvas, GoBtn.BoundsRect, MainTexture);
375 BtnFrame(Canvas, QuitBtn.BoundsRect, MainTexture);
376 // BtnFrame(Canvas,StatBtn.BoundsRect,MainTexture);
377end;
378
379procedure Client(Command, Player: Integer; var Data);
380begin
381 if not FormsCreated then
382 begin
383 FormsCreated := True;
384 Application.CreateForm(TNoTermDlg, NoTermDlg);
385 end;
386 NoTermDlg.Client(Command, Player, Data);
387end;
388
389procedure TNoTermDlg.FormKeyDown(Sender: TObject; var Key: Word;
390 Shift: TShiftState);
391begin
392 if (Char(Key) = 'M') and (ssCtrl in Shift) then
393 if LogDlg.Visible then
394 LogDlg.Close
395 else
396 LogDlg.Show;
397end;
398
399initialization
400
401FormsCreated := False;
402
403end.
Note: See TracBrowser for help on using the repository browser.