source: tags/1.3.1/Direct.pas

Last change on this file was 423, checked in by chronos, 4 years ago
  • Modified: Do not use explicit mode delphi directive as it is already set in project.
  • Modified: Use UNIX instead of LINUX for conditional code to work also on FreeBSD.
File size: 8.9 KB
Line 
1{$INCLUDE Switches.inc}
2unit Direct;
3
4interface
5
6uses
7 Messg,
8
9 LCLIntf, LCLType, {$IFDEF UNIX}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, UNetworkServer,
46 UNetworkClient;
47
48{$R *.lfm}
49
50procedure Notify(ID: TNotify; Index: Integer = 0);
51begin
52 DirectDlg.DlgNotify(ID, Index);
53end;
54
55procedure TDirectDlg.DlgNotify(ID: TNotify; Index: Integer = 0);
56var
57// hMem: Cardinal;
58// p: pointer;
59 s: string;
60Begin
61 case ID of
62 ntInitLocalHuman: begin
63 MainTexture.Age := -1;
64 State := -1;
65 Info := Phrases.Lookup('BUSY_MODLH');
66 Show;
67 Gtk2Fix;
68 Invalidate;
69 Update;
70 end;
71 ntInitModule:
72 if visible then
73 begin
74 s := Format(Phrases.Lookup('BUSY_MOD'), [Brains[Index].Name]);
75 while BiColorTextWidth(Canvas, s) + 64 > ClientWidth do
76 Delete(s, Length(s), 1);
77 SetInfo(s);
78 end;
79 ntCreateWorld:
80 if visible then
81 SetInfo(Phrases.Lookup('BUSY_START'));
82 ntInitPlayers:
83 if visible then
84 SetInfo(Phrases.Lookup('BUSY_INIT'));
85 ntDeactivationMissing:
86 SimpleMessage(Format(Phrases.Lookup('MISSDEACT'), [Index]));
87 ntSetAIName:
88 LocalPlayer.SetAIName(Index, NotifyMessage);
89 ntException:
90 PostMessage(Handle, WM_AIEXCEPTION, Index, 0);
91 ntLoadBegin: begin
92 Info := Phrases.Lookup('BUSY_LOAD');
93 SetState(0);
94 end;
95 ntLoadState: SetState(Index);
96 ntDLLError:
97 SimpleMessage(Format(Phrases.Lookup('DLLERROR'), [Brains[Index].FileName]));
98 ntAIError:
99 SimpleMessage(Format(Phrases.Lookup('AIERROR'), [NotifyMessage]));
100 ntClientError:
101 SimpleMessage(Format(Phrases.Lookup('CLIENTERROR'),
102 [Brains[Index].FileName]));
103 ntEndInfo: begin
104 Hide;
105 Background.Update;
106 end;
107 ntLoadError: begin
108(* TODO if OpenClipboard(Handle) then
109 begin // copy file path to clipboard
110 NotifyMessage := NotifyMessage + #0;
111 hMem := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE,
112 Length(NotifyMessage));
113 p := GlobalLock(hMem);
114 if p <> nil then
115 move(NotifyMessage[1], p^, Length(NotifyMessage));
116 GlobalUnlock(hMem);
117 SetClipboardData(CF_TEXT, hMem);
118 CloseClipboard;
119 end;
120 with MessgDlg do
121 begin
122 MessgText := Phrases.Lookup('LOADERROR');
123 Kind := mkYesNo;
124 ShowModal;
125 if ModalResult = mrOK then
126 OpenURL(CevoContactBug);
127 end
128 *)
129 end;
130 ntStartDone:
131 if not Quick then begin
132 StartDlg.Hide;
133 Background.Update;
134 end;
135 ntStartGo, ntStartGoRefresh, ntStartGoRefreshMaps:
136 if Quick then Close
137 else begin
138 if ID = ntStartGoRefresh then
139 StartDlg.UpdateFormerGames
140 else if ID = ntStartGoRefreshMaps then
141 StartDlg.UpdateMaps;
142 StartDlg.Show;
143 end;
144 ntChangeClient: PostMessage(Handle, WM_CHANGECLIENT, 0, 0);
145 ntNextPlayer: PostMessage(Handle, WM_NEXTPLAYER, 0, 0);
146 ntDeinitModule:
147 begin
148 Info := Format(Phrases2.Lookup('BUSY_DEINIT'),
149 [Brains[Index].Name]);
150 while BiColorTextWidth(Canvas, Info) + 64 > ClientWidth do
151 Delete(Info, Length(Info), 1);
152 MainTexture.Age := -1;
153 State := -1;
154 Show;
155 {$IFDEF UNIX}
156 // Force shown window repaint on Gtk2 widgetset
157 Sleep(1);
158 Application.ProcessMessages;
159 {$ENDIF}
160 Invalidate;
161 Update;
162 end;
163 ntBackOn: begin
164 Background.Show;
165 Background.Update;
166 Sleep(50); // prevent flickering
167 end;
168 ntBackOff: Background.Close;
169 end;
170end;
171
172procedure TDirectDlg.FormCreate(Sender: TObject);
173begin
174 Gone := False;
175 State := -1;
176 Info := '';
177 GameServer.Init(Notify);
178 BrainNoTerm.Client := NoTerm.Client;
179 BrainNoTerm.Name := Phrases.Lookup('AIT');
180 BrainSuperVirtual.Client := nil;
181 BrainSuperVirtual.Name := Phrases.Lookup('SUPER');
182 BrainTerm.Client := LocalPlayer.Client;
183 BrainTerm.Name := Phrases.Lookup('HUMAN');
184 if NetworkEnabled then begin
185 BrainNetworkServer.Client := UNetworkServer.Client;
186 BrainNetworkServer.Name := Phrases.Lookup('NETWORK_SERVER');
187 BrainNetworkClient.Client := UNetworkClient.Client;
188 BrainNetworkClient.Name := Phrases.Lookup('NETWORK_CLIENT');
189 end;
190 BrainRandom.Name := Phrases.Lookup('RANDOMAI');
191 Canvas.Font.Assign(UniFont[ftNormal]);
192 Canvas.Brush.Style := bsClear;
193end;
194
195procedure TDirectDlg.FormShow(Sender: TObject);
196begin
197 if not Gone then
198 begin
199 PostMessage(Handle, WM_GO, 0, 0);
200 Gone := true;
201 end;
202end;
203
204procedure TDirectDlg.FormClose(Sender: TObject; var Action: TCloseAction);
205begin
206 GameServer.Done;
207end;
208
209procedure TDirectDlg.OnGo(var Msg: TMessage);
210var
211 i: integer;
212 s: string;
213 FileName: 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] = '-') {$IFDEF WINDOWS}or (s[1] = '/'){$ENDIF} 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 begin
240 FileName := ParamStr(1);
241 if ExtractFileExt(FileName) = CevoExt then begin
242 Quick := True;
243 if not LoadGame(ExtractFilePath(ParamStr(1)), ExtractFileName(ParamStr(1)
244 ), -1, false) then begin
245 SimpleMessage(Phrases.Lookup('LOADERR'));
246 Close;
247 end;
248 end else
249 if ExtractFileExt(FileName) = CevoMapExt then begin
250 Quick := True;
251 EditMap(FileName, lxmax, lymax, 30);
252 end else begin
253 SimpleMessage(Phrases.Lookup('LOADERR'));
254 Close;
255 end;
256 end;
257 end;
258 if not Quick then begin
259 Background.Show;
260 StartDlg.Show;
261 end;
262end;
263
264procedure TDirectDlg.OnChangeClient(var Msg: TMessage);
265begin
266 ChangeClient;
267end;
268
269procedure TDirectDlg.OnNextPlayer(var Msg: TMessage);
270begin
271 NextPlayer;
272end;
273
274procedure TDirectDlg.OnAIException(var Msg: TMessage);
275begin
276 Application.MessageBox(PChar(Format(Phrases.Lookup('AIEXCEPTION'),
277 [Brains[Msg.WParam].Name])), 'C-evo', 0);
278end;
279
280procedure TDirectDlg.FormPaint(Sender: TObject);
281begin
282 PaintBackground(self, 3, 3, ClientWidth - 6, ClientHeight - 6);
283 Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
284 Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
285 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
286 Frame(Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
287 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
288 if State >= 0 then
289 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info))
290 div 2, 16, Info)
291 else
292 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info)) div 2,
293 (ClientHeight - Canvas.TextHeight(Info)) div 2, Info);
294 if State >= 0 then
295 PaintProgressBar(Canvas, 3, ClientWidth div 2 - 64, 40, State, 0, 128,
296 MainTexture);
297end;
298
299procedure TDirectDlg.SetInfo(x: string);
300begin
301 Info := x;
302 Invalidate;
303 Update;
304 {$IFDEF UNIX}
305 Application.ProcessMessages;
306 {$ENDIF}
307end;
308
309procedure TDirectDlg.SetState(x: integer);
310begin
311 if (x < 0) <> (State < 0) then begin
312 State := x;
313 Invalidate;
314 Update;
315 end
316 else if x <> State then begin
317 State := x;
318 PaintProgressBar(Canvas, 6, ClientWidth div 2 - 64, 40, State, 128 - State,
319 128, MainTexture);
320 end;
321end;
322
323end.
Note: See TracBrowser for help on using the repository browser.