source: branches/AlphaChannel/NoTerm.pas

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