source: tags/1.2.0/Direct.pas

Last change on this file was 190, checked in by chronos, 6 years ago
  • Modified: Code cleanup.
File size: 8.3 KB
Line 
1{$INCLUDE Switches.inc}
2unit Direct;
3
4interface
5
6uses
7 Messg,
8
9 LCLIntf, LCLType, {$IFDEF Linux}LMessages, {$ENDIF}Messages, SysUtils, Classes,
10 Graphics, Controls, Forms, DrawDlg;
11
12const
13 WM_GO = WM_USER;
14 WM_CHANGECLIENT = WM_USER + 1; // hand over control to other client
15 WM_NEXTPLAYER = WM_USER + 2; // active player's turn ended, next player
16 WM_AIEXCEPTION = WM_USER + 3;
17
18type
19 TDirectDlg = class(TDrawDlg)
20 procedure FormShow(Sender: TObject);
21 procedure FormCreate(Sender: TObject);
22 procedure FormPaint(Sender: TObject);
23 procedure FormClose(Sender: TObject; var Action: TCloseAction);
24 public
25 procedure DlgNotify(ID: integer);
26 private
27 Info: string;
28 State: integer;
29 Gone, Quick: boolean;
30 procedure SetInfo(x: string);
31 procedure SetState(x: integer);
32 procedure OnGo(var m: TMessage); message WM_GO;
33 procedure OnChangeClient(var m: TMessage); message WM_CHANGECLIENT;
34 procedure OnNextPlayer(var m: TMessage); message WM_NEXTPLAYER;
35 procedure OnAIException(var Msg: TMessage); message WM_AIEXCEPTION;
36 end;
37
38var
39 DirectDlg: TDirectDlg;
40
41implementation
42
43uses
44 ScreenTools, Protocol, GameServer, Start, LocalPlayer, NoTerm, Back;
45
46{$R *.lfm}
47
48procedure Notify(ID: integer);
49begin
50 DirectDlg.DlgNotify(ID);
51end;
52
53procedure TDirectDlg.DlgNotify(ID: integer);
54var
55// hMem: Cardinal;
56// p: pointer;
57 s: string;
58begin
59 case ID of
60 ntInitLocalHuman:
61 begin
62 SetMainTextureByAge(-1);
63 State := -1;
64 Info := Phrases.Lookup('BUSY_MODLH');
65 Show;
66 Invalidate;
67 Update;
68 end;
69 ntInitModule .. ntInitModule + maxBrain - 1:
70 if visible then
71 begin
72 s := Format(Phrases.Lookup('BUSY_MOD'),
73 [Brains[ID - ntInitModule].Name]);
74 while BiColorTextWidth(Canvas, s) + 64 > ClientWidth do
75 Delete(s, Length(s), 1);
76 SetInfo(s);
77 end;
78 ntCreateWorld:
79 if visible then
80 SetInfo(Phrases.Lookup('BUSY_START'));
81 ntInitPlayers:
82 if visible then
83 SetInfo(Phrases.Lookup('BUSY_INIT'));
84 ntDeactivationMissing .. ntDeactivationMissing + nPl - 1:
85 SimpleMessage(Format(Phrases.Lookup('MISSDEACT'),
86 [ID - ntDeactivationMissing]));
87 ntSetAIName .. ntSetAIName + nPl - 1:
88 LocalPlayer.SetAIName(ID - ntSetAIName, NotifyMessage);
89 ntException .. ntException + maxBrain - 1:
90 PostMessage(Handle, WM_AIEXCEPTION, ID - ntException, 0);
91 ntLoadBegin:
92 begin
93 Info := Phrases.Lookup('BUSY_LOAD');
94 SetState(0);
95 end;
96 ntLoadState .. ntLoadState + 128:
97 SetState(ID - ntLoadState);
98 ntDLLError .. ntDLLError + 128:
99 SimpleMessage(Format(Phrases.Lookup('DLLERROR'),
100 [Brains[ID - ntDLLError].FileName]));
101 ntAIError:
102 SimpleMessage(Format(Phrases.Lookup('AIERROR'), [NotifyMessage]));
103 ntClientError .. ntClientError + 128:
104 SimpleMessage(Format(Phrases.Lookup('CLIENTERROR'),
105 [Brains[ID - ntClientError].FileName]));
106 ntEndInfo:
107 begin
108 Hide;
109 background.Update;
110 end;
111 ntLoadError:
112 begin
113(* TODO if OpenClipboard(Handle) then
114 begin // copy file path to clipboard
115 NotifyMessage := NotifyMessage + #0;
116 hMem := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE,
117 Length(NotifyMessage));
118 p := GlobalLock(hMem);
119 if p <> nil then
120 move(NotifyMessage[1], p^, Length(NotifyMessage));
121 GlobalUnlock(hMem);
122 SetClipboardData(CF_TEXT, hMem);
123 CloseClipboard;
124 end;
125 with MessgDlg do
126 begin
127 MessgText := Phrases.Lookup('LOADERROR');
128 Kind := mkYesNo;
129 ShowModal;
130 if ModalResult = mrOK then
131 OpenURL(CevoContactBug);
132 end
133 *)
134 end;
135 ntStartDone:
136 if not Quick then
137 begin
138 StartDlg.Hide;
139 background.Update;
140 end;
141 ntStartGo, ntStartGoRefresh, ntStartGoRefreshMaps:
142 if Quick then
143 Close
144 else
145 begin
146 if ID = ntStartGoRefresh then
147 StartDlg.UpdateFormerGames
148 else if ID = ntStartGoRefreshMaps then
149 StartDlg.UpdateMaps;
150 StartDlg.Show;
151 end;
152 ntChangeClient:
153 PostMessage(Handle, WM_CHANGECLIENT, 0, 0);
154 ntNextPlayer:
155 PostMessage(Handle, WM_NEXTPLAYER, 0, 0);
156 ntDeinitModule .. ntDeinitModule + maxBrain - 1:
157 begin
158 Info := Format(Phrases2.Lookup('BUSY_DEINIT'),
159 [Brains[ID - ntDeinitModule].Name]);
160 while BiColorTextWidth(Canvas, Info) + 64 > ClientWidth do
161 Delete(Info, Length(Info), 1);
162 SetMainTextureByAge(-1);
163 State := -1;
164 Show;
165 Invalidate;
166 Update;
167 end;
168 ntBackOn:
169 begin
170 background.Show;
171 background.Update;
172 sleep(50); // prevent flickering
173 end;
174 ntBackOff:
175 background.Close;
176 end;
177end;
178
179procedure TDirectDlg.FormCreate(Sender: TObject);
180begin
181 Gone := false;
182 State := -1;
183 Info := '';
184 GameServer.Init(Notify);
185 BrainNoTerm.Client := NoTerm.Client;
186 BrainNoTerm.Name := Phrases.Lookup('AIT');
187 BrainSuperVirtual.Client := nil;
188 BrainSuperVirtual.Name := Phrases.Lookup('SUPER');
189 BrainTerm.Client := LocalPlayer.Client;
190 BrainTerm.Name := Phrases.Lookup('HUMAN');
191 BrainRandom.Name := Phrases.Lookup('RANDOMAI');
192 Canvas.Font.Assign(UniFont[ftNormal]);
193 Canvas.Brush.Style := bsClear;
194end;
195
196procedure TDirectDlg.FormShow(Sender: TObject);
197begin
198 if not Gone then
199 begin
200 PostMessage(Handle, WM_GO, 0, 0);
201 Gone := true;
202 end;
203end;
204
205procedure TDirectDlg.FormClose(Sender: TObject; var Action: TCloseAction);
206begin
207 GameServer.Done;
208end;
209
210procedure TDirectDlg.OnGo(var m: TMessage);
211var
212 i: integer;
213 s: string;
214begin
215 Hide;
216 if Brains.Count = 3 then
217 begin
218 Application.MessageBox(PChar(Phrases.Lookup('NOAI')), 'C-evo', 0);
219 Close;
220 exit;
221 end;
222 Quick := false;
223 if ParamCount > 0 then
224 begin
225 s := ParamStr(1);
226 if (s[1] = '-') or (s[1] = '/') then
227 begin // special mode
228 Delete(s, 1, 1);
229 for i := 1 to Length(s) do
230 if s[i] in ['a' .. 'z'] then
231 dec(s[i], 32);
232 if s = 'MAN' then
233 begin
234 Quick := true;
235 DirectHelp(cHelpOnly);
236 Close
237 end;
238 end
239 else if (FileExists(ParamStr(1))) then
240 begin
241 Quick := true;
242 if not LoadGame(ExtractFilePath(ParamStr(1)), ExtractFileName(ParamStr(1)
243 ), -1, false) then
244 begin
245 SimpleMessage(Phrases.Lookup('LOADERR'));
246 Close;
247 end;
248 end;
249 end;
250 if not Quick then begin
251 background.Show;
252 StartDlg.Show;
253 end;
254end;
255
256procedure TDirectDlg.OnChangeClient(var m: TMessage);
257begin
258 ChangeClient;
259end;
260
261procedure TDirectDlg.OnNextPlayer(var m: TMessage);
262begin
263 NextPlayer;
264end;
265
266procedure TDirectDlg.OnAIException(var Msg: TMessage);
267begin
268 Application.MessageBox(PChar(Format(Phrases.Lookup('AIEXCEPTION'),
269 [Brains[Msg.WParam].Name])), 'C-evo', 0);
270end;
271
272procedure TDirectDlg.FormPaint(Sender: TObject);
273begin
274 PaintBackground(self, 3, 3, ClientWidth - 6, ClientHeight - 6);
275 Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
276 Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
277 MainTexture.clBevelLight, MainTexture.clBevelShade);
278 Frame(Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
279 MainTexture.clBevelLight, MainTexture.clBevelShade);
280 if State >= 0 then
281 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info))
282 div 2, 16, Info)
283 else
284 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info)) div 2,
285 (ClientHeight - Canvas.TextHeight(Info)) div 2, Info);
286 if State >= 0 then
287 PaintProgressBar(Canvas, 3, ClientWidth div 2 - 64, 40, State, 0, 128,
288 MainTexture);
289end;
290
291procedure TDirectDlg.SetInfo(x: string);
292begin
293 Info := x;
294 Invalidate;
295 Update;
296end;
297
298procedure TDirectDlg.SetState(x: integer);
299begin
300 if (x < 0) <> (State < 0) then
301 begin
302 State := x;
303 Invalidate;
304 Update
305 end
306 else if x <> State then
307 begin
308 State := x;
309 PaintProgressBar(Canvas, 6, ClientWidth div 2 - 64, 40, State, 128 - State,
310 128, MainTexture);
311 end;
312end;
313
314end.
Note: See TracBrowser for help on using the repository browser.