source: tags/1.3.0/NoTerm.pas

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