hedgewars/fGame.pas
author unc0rr
Tue, 06 Sep 2005 19:09:39 +0000
changeset 12 366adfa1a727
parent 4 bcbd7adb4e4b
permissions -rw-r--r--
Fix reading out of bounds of the collisions array. This fixes flying hedgehogs and not moving after explosion

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