source: tags/1.3.4/Direct.pas

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