source: trunk/Direct.pas@ 347

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