source: tags/1.3.1/NoTerm.pas

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