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 fMisc;

    35 {$J+}

    36 interface

    37 uses uConsts, Windows;

    38 const

    39       fWriteDemo: boolean = false;

    40 type

    41       TGameType = (gtLocal, gtNet, gtDemo);

    42       TCommandHandler = procedure (s: shortstring);

    43 

    44 procedure ExecCFG(FileName: String);

    45 procedure AssignDemoFile(Filename: shortstring);

    46 procedure WriteRawToDemo(s: shortstring);

    47 procedure WriteStrToDemo(s: shortstring);

    48 procedure CloseDemoFile;

    49 procedure GenRandomSeed;

    50 procedure SaveSettings;

    51 procedure SplitStream2Commands(var ss: string; Handler: TCommandHandler);

    52 function MainWndProc(hwnd: HWND;  Message: UINT;  wParam: WPARAM;  lParam: LPARAM): LRESULT; stdcall;

    53 procedure LoadOwnerBitmap(var bmp: HBITMAP; name: string; var dc: HDC; owner:cardinal );

    54 procedure DoInit;

    55 procedure InitWSA;

    56 

    57 var

    58     seed: shortstring;

    59     GameType: TGameType;

    60 

    61 implementation

    62 uses fIPC, uRandom, IniFiles, SysUtils, Messages, fGUI, fNet, WinSock, fOptionsGUI;

    63 var fDemo: file;

    64 

    65 procedure ExecCFG(FileName: String);

    66 var f: textfile;

    67     s: shortstring;

    68 begin

    69 AssignFile(f, FileName);

    70 {$I-}

    71 Reset(f);

    72 {$I+}

    73 if IOResult<>0 then SendIPC('ECannot open file: "' + FileName + '"');

    74 while not eof(f) do

    75       begin

    76       ReadLn(f, s);

    77       if (s[0]<>#0)and(s[1]<>';') then SendIPC('e' + s);

    78       end;

    79 CloseFile(f)

    80 end;

    81 

    82 procedure AssignDemoFile(Filename: shortstring);

    83 begin

    84 Assign(fDemo, Filename);

    85 Rewrite(fDemo, 1)

    86 end;

    87 

    88 procedure WriteRawToDemo(s: shortstring);

    89 begin

    90 if not fWriteDemo then exit;

    91 BlockWrite(fDemo, s[0], Succ(byte(s[0])))

    92 end;

    93 

    94 procedure WriteStrToDemo(s: shortstring);

    95 begin

    96 if not fWriteDemo then exit;

    97 BlockWrite(fDemo, s[1], byte(s[0]))

    98 end;

    99 

   100 procedure CloseDemoFile;

   101 begin

   102 CloseFile(fDemo)

   103 end;

   104 

   105 procedure GenRandomSeed;

   106 var i: integer;

   107 begin

   108 seed[0]:= chr(7 + GetRandom(6));

   109 for i:= 1 to byte(seed[0]) do seed[i]:= chr(byte('A') + GetRandom(26));

   110 seed:= '('+seed+')'

   111 end;

   112 

   113 procedure SaveSettings;

   114 var inif: TIniFile;

   115 begin

   116 inif:= TIniFile.Create(ExtractFilePath(ParamStr(0))+'hw.ini');

   117 inif.WriteInteger('Misc', 'ResIndex', SendMessage(HSetResEdit, CB_GETCURSEL, 0, 0));

   118 inif.WriteInteger('Misc', 'EnableSound', SendMessage(HSetSndCheck, BM_GETCHECK, 0, 0));

   119 inif.WriteInteger('Misc', 'Fullscreen', SendMessage(HFullScrCheck, BM_GETCHECK, 0, 0));

   120 inif.UpdateFile;

   121 inif.Free

   122 end;

   123 

   124 procedure SplitStream2Commands(var ss: string; Handler: TCommandHandler);

   125 var s: shortstring;

   126 begin

   127 while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do

   128       begin

   129       s:= copy(ss, 2, byte(ss[1]));

   130       Delete(ss, 1, Succ(byte(ss[1])));

   131       Handler(s)

   132       end;

   133 end;

   134 

   135 function MainWndProc(hwnd: HWND;  Message: UINT;  wParam: WPARAM;  lParam: LPARAM): LRESULT; stdcall;

   136 begin

   137 case Message of

   138      WM_ASYNC_IPCEVENT: IPCEvent(wParam, lParam);

   139      WM_ASYNC_NETEVENT: NetEvent(wParam, lParam);

   140      WM_COMMAND : DoControlPress(wParam, lParam);

   141      WM_DRAWITEM: DoDrawButton(wParam,PDRAWITEMSTRUCT(lParam));

   142      WM_CLOSE   : PostQuitMessage(0);

   143      WM_DESTROY : if hwnd = hwndMain then DoDestroy

   144      end;

   145 Result:= DefWindowProc(hwnd, Message, wParam,lParam)

   146 end;

   147 

   148 procedure LoadOwnerBitmap(var bmp: HBITMAP; name: string; var dc: HDC; owner:cardinal );

   149 begin

   150 bmp := LoadImage(0,PChar(name), IMAGE_BITMAP,0,0,LR_LOADFROMFILE);

   151 if bmp = 0 then

   152    begin

   153    MessageBox(hwndMain, PChar(name + ' not found'), 'damn', MB_OK);

   154    PostQuitMessage(0);

   155    end;

   156 dc:=CreateCompatibleDC(GetDC(owner));

   157 SelectObject(dc,bmp);

   158 end;

   159 

   160 procedure DoInit;

   161 var sr: TSearchRec;

   162     i: integer;

   163     inif: TIniFile;

   164     p: TPoint;

   165 begin

   166 GetCursorPos(p);

   167 SetRandomParams(IntToStr(GetTickCount), IntToStr(p.X)+'(ρευσ)'+IntToStr(p.Y));

   168 i:= FindFirst('Data\Maps\*', faDirectory, sr);

   169 while i=0 do

   170       begin

   171       if sr.Name[1]<>'.' then ;//LBMaps.Items.Add(sr.Name);

   172       i:= FindNext(sr)

   173       end;

   174 FindClose(sr);

   175 

   176 inif:= TIniFile.Create(ExtractFilePath(ParamStr(0))+'hw.ini');

   177 i:= inif.ReadInteger('Misc', 'ResIndex', 0);

   178 if inif.ReadBool('Misc', 'EnableSound', true) then SendMessage(HSetSndCheck,BM_SETCHECK,BST_CHECKED,0);

   179 if inif.ReadBool('Misc', 'Fullscreen', true) then SendMessage(HFullScrCheck,BM_SETCHECK,BST_CHECKED,0);

   180 if (i>=0)and(i<=3) then SendMessage(HSetResEdit,CB_SETCURSEL,i,0);

   181 SetWindowText(HNetIPEdit,PChar(inif.ReadString('Net','IP'  , ''       )));

   182 SetWindowText(HNetNameEdit,PChar(inif.ReadString('Net','Nick', 'Unnamed')));

   183 inif.Free;

   184 SendMessage(HSetDemoCheck, BM_SETCHECK, BST_CHECKED, 0);

   185 end;

   186 

   187 procedure InitWSA;

   188 var stWSADataTCPIP: WSADATA;

   189 begin

   190 if WSAStartup($0101, stWSADataTCPIP)<>0 then

   191    begin

   192    MessageBox(0, 'WSAStartup error !', 'NET ERROR!!!', 0);

   193    halt

   194    end;

   195 if not InitIPCServer then

   196    begin

   197    MessageBox(0, 'Error on init IPC server!', 'IPC Error', 0);

   198    halt

   199    end

   200 end;

   201 

   202 

   203 end.