source: tags/1.3.8/Direct.pas

Last change on this file was 666, checked in by chronos, 4 weeks ago
  • Added: Music volume option in game settings form.
File size: 9.0 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, Music, Directories;
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: begin
133 if not Quick then begin
134 StartDlg.Hide;
135 Background.Update;
136 end;
137 if MusicEnabled then begin
138 MusicPlayer.LoadPlaylistFromDir(GetMusicDir);
139 MusicPlayer.RandomizePlaylist;
140 if MusicPlayer.Playlist.Count > 0 then MusicPlayer.Play;
141 end;
142 end;
143 ntStartGo, ntStartGoRefresh, ntStartGoRefreshMaps:
144 if Quick then Close
145 else begin
146 if ID = ntStartGoRefresh then
147 StartDlg.UpdateFormerGames
148 else if ID = ntStartGoRefreshMaps then
149 StartDlg.UpdateMaps(False);
150 StartDlg.Show;
151 end;
152 ntChangeClient: PostMessage(Handle, WM_CHANGECLIENT, 0, 0);
153 ntNextPlayer: PostMessage(Handle, WM_NEXTPLAYER, 0, 0);
154 ntDeinitModule:
155 begin
156 Info := Format(Phrases2.Lookup('BUSY_DEINIT'),
157 [Brains[Index].Name]);
158 while BiColorTextWidth(Canvas, Info) + 64 > ClientWidth do
159 Delete(Info, Length(Info), 1);
160 MainTexture.Age := -1;
161 State := -1;
162 Show;
163 Gtk2Fix;
164 Invalidate;
165 Update;
166 end;
167 ntBackOn: begin
168 Background.Show;
169 Background.Update;
170 Sleep(50); // prevent flickering
171 end;
172 ntBackOff: Background.Close;
173 end;
174end;
175
176procedure TDirectDlg.FormCreate(Sender: TObject);
177begin
178 Gone := False;
179 State := -1;
180 Info := '';
181 GameServer.Init(Notify);
182 BrainNoTerm.Client := NoTerm.Client;
183 BrainNoTerm.LookupName := 'AIT';
184 BrainSuperVirtual.Client := nil;
185 BrainSuperVirtual.LookupName := 'SUPER';
186 BrainTerm.Client := LocalPlayer.Client;
187 BrainTerm.LookupName := 'HUMAN';
188 if NetworkEnabled then begin
189 BrainNetworkServer.Client := NetworkServer.Client;
190 BrainNetworkServer.LookupName := 'NETWORK_SERVER';
191 BrainNetworkClient.Client := NetworkClient.Client;
192 BrainNetworkClient.LookupName := 'NETWORK_CLIENT';
193 end;
194 BrainRandom.LookupName := 'RANDOMAI';
195 Canvas.Font.Assign(UniFont[ftNormal]);
196 Canvas.Brush.Style := TBrushStyle.bsClear;
197end;
198
199procedure TDirectDlg.FormShow(Sender: TObject);
200begin
201 if not Gone then
202 begin
203 PostMessage(Handle, WM_GO, 0, 0);
204 Gone := True;
205 end;
206end;
207
208procedure TDirectDlg.FormClose(Sender: TObject; var Action: TCloseAction);
209begin
210 GameServer.Done;
211end;
212
213procedure TDirectDlg.OnGo(var Msg: TMessage);
214var
215 I: Integer;
216 S: string;
217 FileName: string;
218begin
219 Hide;
220 if Brains.Count = 3 then
221 begin
222 Application.MessageBox(PChar(Phrases.Lookup('NOAI')), 'C-evo', 0);
223 Close;
224 Exit;
225 end;
226 Quick := False;
227 if ParamCount > 0 then
228 begin
229 S := ParamStr(1);
230 if (S[1] = '-') {$IFDEF WINDOWS}or (S[1] = '/'){$ENDIF} then
231 begin // special mode
232 Delete(S, 1, 1);
233 for I := 1 to Length(S) do
234 if S[I] in ['a' .. 'z'] then
235 Dec(S[I], 32);
236 if S = 'MAN' then
237 begin
238 Quick := True;
239 DirectHelp(cHelpOnly);
240 Close;
241 end;
242 end
243 else if (FileExists(ParamStr(1))) then begin
244 FileName := ParamStr(1);
245 if ExtractFileExt(FileName) = CevoExt then begin
246 Quick := True;
247 if not LoadGame(ParamStr(1), -1, False) then begin
248 SimpleMessage(Phrases.Lookup('LOADERR'));
249 Close;
250 end;
251 end else
252 if ExtractFileExt(FileName) = CevoMapExt then begin
253 Quick := True;
254 EditMap(FileName, lxmax, lymax, 30);
255 end else begin
256 SimpleMessage(Phrases.Lookup('LOADERR'));
257 Close;
258 end;
259 end;
260 end;
261 if not Quick then begin
262 Background.Show;
263 StartDlg.Show;
264 end;
265end;
266
267procedure TDirectDlg.OnChangeClient(var Msg: TMessage);
268begin
269 ChangeClient;
270end;
271
272procedure TDirectDlg.OnNextPlayer(var Msg: TMessage);
273begin
274 NextPlayer;
275end;
276
277procedure TDirectDlg.OnAIException(var Msg: TMessage);
278begin
279 Application.MessageBox(PChar(Format(Phrases.Lookup('AIEXCEPTION'),
280 [Brains[Msg.WParam].Name])), 'C-evo', 0);
281end;
282
283procedure TDirectDlg.FormPaint(Sender: TObject);
284begin
285 PaintBackground(Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,
286 ClientWidth, ClientHeight);
287 Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
288 Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
289 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
290 Frame(Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
291 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
292 if State >= 0 then
293 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info))
294 div 2, 16, Info)
295 else
296 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info)) div 2,
297 (ClientHeight - Canvas.TextHeight(Info)) div 2, Info);
298 if State >= 0 then
299 PaintProgressBar(Canvas, 3, ClientWidth div 2 - 64, 40, State, 0, 128,
300 MainTexture);
301end;
302
303procedure TDirectDlg.SetInfo(X: string);
304begin
305 Info := X;
306 Invalidate;
307 Update;
308 {$IFDEF UNIX}
309 Application.ProcessMessages;
310 {$ENDIF}
311end;
312
313procedure TDirectDlg.SetState(X: Integer);
314begin
315 if (X < 0) <> (State < 0) then begin
316 State := X;
317 Invalidate;
318 Update;
319 end
320 else if X <> State then begin
321 State := X;
322 PaintProgressBar(Canvas, 6, ClientWidth div 2 - 64, 40, State, 128 - State,
323 128, MainTexture);
324 end;
325end;
326
327end.
Note: See TracBrowser for help on using the repository browser.