--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/fGame.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,232 @@
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>
+ *
+ * Distributed under the terms of the BSD-modified licence:
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a copy
+ * of this software and associated documentation files (the "Software"), to deal
+ * with the Software without restriction, including without limitation the
+ * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+ * sell copies of the Software, and to permit persons to whom the Software is
+ * furnished to do so, subject to the following conditions:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ * this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ * 3. The name of the author may not be used to endorse or promote products
+ * derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
+ * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
+ * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+unit fGame;
+interface
+uses Windows;
+
+procedure GameStart;
+procedure StartNetGame;
+procedure StartDemoView;
+procedure StartLocalGame;
+
+implementation
+uses fMisc, fGUI, uConsts, uRandom, Messages, fConsts, SysUtils, fIPC, fNet;
+const
+ fmCreate = $FFFF;
+ fmOpenRead = $0000;
+ fmOpenWrite = $0001;
+ fmOpenReadWrite = $0002;
+
+var
+ MapPoints: array[0..19] of TPoint;
+
+function GetNextLine(var f: textfile): string;
+begin
+repeat
+ Readln(f, Result)
+until (Length(Result)>0)and(Result[1] <> '#')
+end;
+
+function GetThemeBySeed: string;
+var f: text;
+ i, n, t: integer;
+begin
+Result:= '';
+n:= 37;
+for i:= 1 to Length(seed) do
+ n:= (n shl 1) xor byte(seed[i]) xor n;
+FileMode:= fmOpenRead;
+AssignFile(f, Pathz[ptThemes] + 'themes.cfg');
+{$I-}
+Reset(f);
+val(GetNextLine(f), i, t);
+if i > 0 then
+ begin
+ n:= n mod i;
+ for i:= 0 to n do Result:= GetNextLine(f)
+ end;
+CloseFile(f);
+{$I+}
+FileMode:= fmOpenReadWrite;
+if IOResult <> 0 then
+ begin
+ MessageBox(hwndMain,PChar(String('Missing, corrupted or cannot access critical file'#13#10+Pathz[ptThemes] + 'themes.cfg')),'Ahctung!!!',MB_OK);
+ exit
+ end
+end;
+
+function ExecAndWait(FileName:String; Visibility : integer): Cardinal;
+var WorkDir: String;
+ StartupInfo:TStartupInfo;
+ ProcessInfo:TProcessInformation;
+begin
+GetDir(0, WorkDir);
+FillChar(StartupInfo, Sizeof(StartupInfo), 0);
+with StartupInfo do
+ begin
+ cb:= Sizeof(StartupInfo);
+ dwFlags:= STARTF_USESHOWWINDOW;
+ wShowWindow:= Visibility
+ end;
+if not CreateProcess(nil, PChar(FileName), nil, nil,
+ false, CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
+ nil, nil, StartupInfo, ProcessInfo)
+ then Result:= High(Cardinal)
+ else begin
+ while WaitforSingleObject(ProcessInfo.hProcess, 0) = WAIT_TIMEOUT do
+ begin
+ Sleep(10);
+ ProcessMessages;
+ end;
+ GetExitCodeProcess(ProcessInfo.hProcess, Result);
+ CloseHandle(ProcessInfo.hProcess);
+ CloseHandle(ProcessInfo.hThread)
+ end
+end;
+
+procedure GameStart;
+var sTheme:string;
+begin
+if seed = '' then
+ begin
+ MessageBox(hwndMain,'seed is unknown, but game started','Ahctung!!!',MB_OK);
+ exit
+ end;
+sTheme:= GetThemeBySeed;
+//if ExecAndWait('landgen.exe ' + sTheme + ' ' + seed, SW_HIDE) = 0 then
+ begin
+ ShowWindow(hwndMain, SW_MINIMIZE);
+ fWriteDemo:= SendMessage(HSetDemoCheck, BM_GETCHECK, 0, 0) = BST_CHECKED;
+ if fWriteDemo then
+ begin
+ AssignDemoFile('demo.hwd_1');
+ inc(seed[0]);
+ seed[Length(seed)]:= cDemoSeedSeparator;
+ WriteStrToDemo(seed)
+ end;
+ 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
+ High(Cardinal): MessageBox(hwndMain,'error executing game','fuck!',MB_OK);
+ end;
+ if fWriteDemo then
+ CloseDemoFile;
+ seed:= '';
+ ShowWindow(hwndMain, SW_RESTORE)
+ end {else begin
+ MessageBox(hwndMain,'error executing landgen','fuck!',MB_OK);
+ exit
+ end; }
+end;
+
+procedure StartNetGame;
+var i, ii: LongWord;
+ s: shortstring;
+ p: TPoint;
+ sbuf: string;
+begin // totally broken
+GenRandomSeed;
+SendNet('z'+seed);
+sbuf:= GetThemeBySeed;
+if ExecAndWait(format('landgen.exe %s %s',[sbuf, seed]), SW_HIDE) <> 0 then
+ begin
+ MessageBox(hwndMain,'error executing landgen','error',MB_OK);
+ exit;
+ end;
+SendNetAndWait('T');
+SendNet('K'); {
+for i:= 1 to TeamCount do
+ begin
+ s[0]:= #9;
+ s[1]:= 'h';
+ for ii:= 0 to 1 do
+ begin
+ p:= GetRandomMapPoint;
+ PLongWord(@s[2])^:= p.X;
+ PLongWord(@s[6])^:= p.Y;
+ SendNet(s);
+ end;
+ if i < TeamCount then SendNet('k');
+ end; }
+SendNet('G')
+end;
+
+procedure StartDemoView;
+const cBufSize = 32;
+var f: file;
+ buf: array[0..pred(cBufSize)] of byte;
+ i, t: integer;
+begin
+if SendMessage(HDemoList,LB_GETCURSEL,0,0) = LB_ERR then//LBDemos.ItemIndex<0 then
+ begin
+ MessageBox(hwndMain,'Выбери демку слева','hint',MB_OK);
+ exit
+ end;
+GameType:= gtDemo;
+i:= SendMessage(HDemoList,LB_GETCURSEL,0,0);
+t:= SendMessage(HDemoList, LB_GETTEXTLEN, i, 0);
+SetLength(DemoFileName, t);
+SendMessage(HDemoList,LB_GETTEXT, i, LPARAM(@DemoFileName[1]));
+DemoFileName:= Pathz[ptDemos] + DemoFileName;
+AssignFile(f, DemoFileName);
+{$I-}
+FileMode:= fmOpenRead;
+Reset(f, 1);
+FileMode:= fmOpenReadWrite;
+if IOResult <> 0 then
+ begin
+ MessageBox(hwndMain,'file not found','error',MB_OK);
+ exit;
+ end;
+BlockRead(f, buf, cBufSize, t); // вырезаем seed
+seed:= '';
+i:= 0;
+while (char(buf[i]) <> cDemoSeedSeparator)and (i < t) do
+ begin
+ seed:= seed + chr(buf[i]);
+ inc(i);
+ end;
+CloseFile(f);
+{$I+}
+GameStart
+end;
+
+procedure StartLocalGame;
+begin
+GenRandomSeed;
+GameType:= gtLocal;
+GameStart
+end;
+
+
+
+end.