(*

 * 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.