1 (* |
|
2 * Hedgewars, a worms-like game |
|
3 * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com> |
|
4 * |
|
5 * Distributed under the terms of the BSD-modified licence: |
|
6 * |
|
7 * Permission is hereby granted, free of charge, to any person obtaining a copy |
|
8 * of this software and associated documentation files (the "Software"), to deal |
|
9 * with the Software without restriction, including without limitation the |
|
10 * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or |
|
11 * sell copies of the Software, and to permit persons to whom the Software is |
|
12 * furnished to do so, subject to the following conditions: |
|
13 * |
|
14 * 1. Redistributions of source code must retain the above copyright notice, |
|
15 * this list of conditions and the following disclaimer. |
|
16 * 2. Redistributions in binary form must reproduce the above copyright notice, |
|
17 * this list of conditions and the following disclaimer in the documentation |
|
18 * and/or other materials provided with the distribution. |
|
19 * 3. The name of the author may not be used to endorse or promote products |
|
20 * derived from this software without specific prior written permission. |
|
21 * |
|
22 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED |
|
23 * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF |
|
24 * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO |
|
25 * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
|
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, |
|
27 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; |
|
28 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, |
|
29 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR |
|
30 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF |
|
31 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
|
32 *) |
|
33 |
|
34 unit fGame; |
|
35 interface |
|
36 uses Windows; |
|
37 |
|
38 procedure GameStart; |
|
39 procedure StartNetGame; |
|
40 procedure StartDemoView; |
|
41 procedure StartLocalGame; |
|
42 |
|
43 implementation |
|
44 uses fMisc, fGUI, uConsts, uRandom, Messages, fConsts, SysUtils, fIPC, fNet; |
|
45 const |
|
46 fmCreate = $FFFF; |
|
47 fmOpenRead = $0000; |
|
48 fmOpenWrite = $0001; |
|
49 fmOpenReadWrite = $0002; |
|
50 |
|
51 var |
|
52 MapPoints: array[0..19] of TPoint; |
|
53 |
|
54 function GetNextLine(var f: textfile): string; |
|
55 begin |
|
56 repeat |
|
57 Readln(f, Result) |
|
58 until (Length(Result)>0)and(Result[1] <> '#') |
|
59 end; |
|
60 |
|
61 function GetThemeBySeed: string; |
|
62 var f: text; |
|
63 i, n, t: integer; |
|
64 begin |
|
65 Result:= ''; |
|
66 n:= 37; |
|
67 for i:= 1 to Length(seed) do |
|
68 n:= (n shl 1) xor byte(seed[i]) xor n; |
|
69 FileMode:= fmOpenRead; |
|
70 AssignFile(f, Pathz[ptThemes] + 'themes.cfg'); |
|
71 {$I-} |
|
72 Reset(f); |
|
73 val(GetNextLine(f), i, t); |
|
74 if i > 0 then |
|
75 begin |
|
76 n:= n mod i; |
|
77 for i:= 0 to n do Result:= GetNextLine(f) |
|
78 end; |
|
79 CloseFile(f); |
|
80 {$I+} |
|
81 FileMode:= fmOpenReadWrite; |
|
82 if IOResult <> 0 then |
|
83 begin |
|
84 MessageBox(hwndMain,PChar(String('Missing, corrupted or cannot access critical file'#13#10+Pathz[ptThemes] + 'themes.cfg')),'Ahctung!!!',MB_OK); |
|
85 exit |
|
86 end |
|
87 end; |
|
88 |
|
89 function ExecAndWait(FileName:String; Visibility : integer): Cardinal; |
|
90 var WorkDir: String; |
|
91 StartupInfo:TStartupInfo; |
|
92 ProcessInfo:TProcessInformation; |
|
93 begin |
|
94 GetDir(0, WorkDir); |
|
95 FillChar(StartupInfo, Sizeof(StartupInfo), 0); |
|
96 with StartupInfo do |
|
97 begin |
|
98 cb:= Sizeof(StartupInfo); |
|
99 dwFlags:= STARTF_USESHOWWINDOW; |
|
100 wShowWindow:= Visibility |
|
101 end; |
|
102 if not CreateProcess(nil, PChar(FileName), nil, nil, |
|
103 false, CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, |
|
104 nil, nil, StartupInfo, ProcessInfo) |
|
105 then Result:= High(Cardinal) |
|
106 else begin |
|
107 while WaitforSingleObject(ProcessInfo.hProcess, 0) = WAIT_TIMEOUT do |
|
108 begin |
|
109 Sleep(10); |
|
110 ProcessMessages; |
|
111 end; |
|
112 GetExitCodeProcess(ProcessInfo.hProcess, Result); |
|
113 CloseHandle(ProcessInfo.hProcess); |
|
114 CloseHandle(ProcessInfo.hThread) |
|
115 end |
|
116 end; |
|
117 |
|
118 procedure GameStart; |
|
119 var sTheme:string; |
|
120 begin |
|
121 if seed = '' then |
|
122 begin |
|
123 MessageBox(hwndMain,'seed is unknown, but game started','Ahctung!!!',MB_OK); |
|
124 exit |
|
125 end; |
|
126 sTheme:= GetThemeBySeed; |
|
127 //if ExecAndWait('landgen.exe ' + sTheme + ' ' + seed, SW_HIDE) = 0 then |
|
128 begin |
|
129 ShowWindow(hwndMain, SW_MINIMIZE); |
|
130 fWriteDemo:= SendMessage(HSetDemoCheck, BM_GETCHECK, 0, 0) = BST_CHECKED; |
|
131 if fWriteDemo then |
|
132 begin |
|
133 AssignDemoFile('demo.hwd_1'); |
|
134 inc(seed[0]); |
|
135 seed[Length(seed)]:= cDemoSeedSeparator; |
|
136 WriteStrToDemo(seed) |
|
137 end; |
|
138 case ExecAndWait(format('hw.exe %s %s %d %s %d',[Resolutions[SendMessage(HSetResEdit,CB_GETCURSEL,0,0)], sTheme, IN_IPC_PORT, seed, SendMessage(HFullScrCheck,BM_GETCHECK,0,0)]), SW_NORMAL) of |
|
139 High(Cardinal): MessageBox(hwndMain,'error executing game','fuck!',MB_OK); |
|
140 end; |
|
141 if fWriteDemo then |
|
142 CloseDemoFile; |
|
143 seed:= ''; |
|
144 ShowWindow(hwndMain, SW_RESTORE) |
|
145 end {else begin |
|
146 MessageBox(hwndMain,'error executing landgen','fuck!',MB_OK); |
|
147 exit |
|
148 end; } |
|
149 end; |
|
150 |
|
151 procedure StartNetGame; |
|
152 var i, ii: LongWord; |
|
153 s: shortstring; |
|
154 p: TPoint; |
|
155 sbuf: string; |
|
156 begin // totally broken |
|
157 GenRandomSeed; |
|
158 SendNet('z'+seed); |
|
159 sbuf:= GetThemeBySeed; |
|
160 if ExecAndWait(format('landgen.exe %s %s',[sbuf, seed]), SW_HIDE) <> 0 then |
|
161 begin |
|
162 MessageBox(hwndMain,'error executing landgen','error',MB_OK); |
|
163 exit; |
|
164 end; |
|
165 SendNetAndWait('T'); |
|
166 SendNet('K'); { |
|
167 for i:= 1 to TeamCount do |
|
168 begin |
|
169 s[0]:= #9; |
|
170 s[1]:= 'h'; |
|
171 for ii:= 0 to 1 do |
|
172 begin |
|
173 p:= GetRandomMapPoint; |
|
174 PLongWord(@s[2])^:= p.X; |
|
175 PLongWord(@s[6])^:= p.Y; |
|
176 SendNet(s); |
|
177 end; |
|
178 if i < TeamCount then SendNet('k'); |
|
179 end; } |
|
180 SendNet('G') |
|
181 end; |
|
182 |
|
183 procedure StartDemoView; |
|
184 const cBufSize = 32; |
|
185 var f: file; |
|
186 buf: array[0..pred(cBufSize)] of byte; |
|
187 i, t: integer; |
|
188 begin |
|
189 if SendMessage(HDemoList,LB_GETCURSEL,0,0) = LB_ERR then//LBDemos.ItemIndex<0 then |
|
190 begin |
|
191 MessageBox(hwndMain,'Выбери демку слева','hint',MB_OK); |
|
192 exit |
|
193 end; |
|
194 GameType:= gtDemo; |
|
195 i:= SendMessage(HDemoList,LB_GETCURSEL,0,0); |
|
196 t:= SendMessage(HDemoList, LB_GETTEXTLEN, i, 0); |
|
197 SetLength(DemoFileName, t); |
|
198 SendMessage(HDemoList,LB_GETTEXT, i, LPARAM(@DemoFileName[1])); |
|
199 DemoFileName:= Pathz[ptDemos] + DemoFileName; |
|
200 AssignFile(f, DemoFileName); |
|
201 {$I-} |
|
202 FileMode:= fmOpenRead; |
|
203 Reset(f, 1); |
|
204 FileMode:= fmOpenReadWrite; |
|
205 if IOResult <> 0 then |
|
206 begin |
|
207 MessageBox(hwndMain,'file not found','error',MB_OK); |
|
208 exit; |
|
209 end; |
|
210 BlockRead(f, buf, cBufSize, t); // вырезаем seed |
|
211 seed:= ''; |
|
212 i:= 0; |
|
213 while (char(buf[i]) <> cDemoSeedSeparator)and (i < t) do |
|
214 begin |
|
215 seed:= seed + chr(buf[i]); |
|
216 inc(i); |
|
217 end; |
|
218 CloseFile(f); |
|
219 {$I+} |
|
220 GameStart |
|
221 end; |
|
222 |
|
223 procedure StartLocalGame; |
|
224 begin |
|
225 GenRandomSeed; |
|
226 GameType:= gtLocal; |
|
227 GameStart |
|
228 end; |
|
229 |
|
230 |
|
231 |
|
232 end. |
|