hedgewars/hw.dpr
changeset 1 30f2d1037d5d
child 2 4eeab397c3c6
equal deleted inserted replaced
0:475c0f2f9d17 1:30f2d1037d5d
       
     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 program hedgewars;
       
    35 {$APPTYPE CONSOLE}
       
    36 uses
       
    37   SDLh,
       
    38   uConsts in 'uConsts.pas',
       
    39   uGame in 'uGame.pas',
       
    40   uMisc in 'uMisc.pas',
       
    41   uStore in 'uStore.pas',
       
    42   uWorld in 'uWorld.pas',
       
    43   uIO in 'uIO.pas',
       
    44   uGears in 'uGears.pas',
       
    45   uConsole in 'uConsole.pas',
       
    46   uKeys in 'uKeys.pas',
       
    47   uTeams in 'uTeams.pas',
       
    48   uSound in 'uSound.pas',
       
    49   uRandom in 'uRandom.pas',
       
    50   uAI in 'uAI.pas',
       
    51   uAIActions in 'uAIActions.pas',
       
    52   uAIMisc in 'uAIMisc.pas',
       
    53   uAIAmmoTests in 'uAIAmmoTests.pas',
       
    54   uCollisions in 'uCollisions.pas',
       
    55   uLand in 'uLand.pas';
       
    56 
       
    57 {$INCLUDE options.inc}
       
    58 
       
    59 // also: GSHandlers.inc
       
    60 //       CCHandlers.inc
       
    61 //       HHHandlers.inc
       
    62 
       
    63 
       
    64 procedure OnDestroy; forward;
       
    65 
       
    66 ////////////////////////////////
       
    67 procedure DoTimer(Lag: integer);  // - обработка таймера
       
    68 const cCons: boolean = false;
       
    69 var s: string;
       
    70 begin
       
    71 case GameState of
       
    72    gsLandGen: begin
       
    73               GenLandSurface;
       
    74               //MakeFortsMap;
       
    75               GameState:= gsStart;
       
    76               end;
       
    77      gsStart: begin
       
    78               AssignHHCoords;
       
    79               AdjustColor(cColorNearBlack);
       
    80               AdjustColor(cWhiteColor);
       
    81               StoreLoad;
       
    82               AdjustColor(cConsoleSplitterColor);
       
    83               ResetKbd;
       
    84               SoundLoad;
       
    85               PlayMusic;
       
    86               GameState:= gsGame
       
    87               end;
       
    88      gsGame : begin
       
    89               ProcessKbd;
       
    90               DoGameTick(Lag);
       
    91               DrawWorld(Lag, SDLPrimSurface);
       
    92               end;
       
    93    gsConsole: begin
       
    94               DoGameTick(Lag);
       
    95               DrawWorld(Lag, SDLPrimSurface);
       
    96               DrawConsole(SDLPrimSurface);
       
    97               end;
       
    98      gsExit : begin
       
    99               OnDestroy;
       
   100               end;
       
   101      end;
       
   102 SDL_Flip(SDLPrimSurface);
       
   103 if flagMakeCapture then
       
   104    begin
       
   105    flagMakeCapture:= false;
       
   106    s:= 'hw_' + ParamStr(5) + '_' + inttostr(GameTicks) + '.bmp';
       
   107    WriteLnToConsole('Saving ' + s);
       
   108    SDL_SaveBMP_RW(SDLPrimSurface, SDL_RWFromFile(PChar(s), 'wb'), 1)
       
   109    end;
       
   110 end;
       
   111 
       
   112 ////////////////////
       
   113 procedure OnDestroy;   // - очищаем память
       
   114 begin
       
   115 {$IFDEF DEBUGFILE}AddFileLog('Freeing resources...');{$ENDIF}
       
   116 if isSoundEnabled then ReleaseSound;
       
   117 StoreRelease;
       
   118 CloseIPC;
       
   119 TTF_Quit;
       
   120 SDL_Quit;
       
   121 halt
       
   122 end;
       
   123 
       
   124 ///////////////////
       
   125 procedure MainLoop;
       
   126 var PrevTime,
       
   127     CurrTime: Cardinal;
       
   128     event: TSDL_Event;
       
   129 begin
       
   130 PrevTime:= SDL_GetTicks;
       
   131 repeat
       
   132 while SDL_PollEvent(@event) <> 0 do
       
   133       case event.type_ of
       
   134            SDL_KEYDOWN: case GameState of
       
   135                              gsGame: if event.key.keysym.sym = 96 then
       
   136                                         begin
       
   137                                         cConsoleYAdd:= cConsoleHeight;
       
   138                                         GameState:= gsConsole
       
   139                                         end;
       
   140                           gsConsole: KeyPressConsole(event.key.keysym.sym);
       
   141                              end;
       
   142            SDL_QUITEV: isTerminated:= true
       
   143            end;
       
   144 CurrTime:= SDL_GetTicks;
       
   145 if PrevTime + cTimerInterval <= CurrTime then
       
   146    begin
       
   147    DoTimer(CurrTime - PrevTime);
       
   148    PrevTime:= CurrTime
       
   149    end else {sleep(1)};
       
   150 IPCCheckSock
       
   151 until isTerminated
       
   152 end;
       
   153 
       
   154 ////////////////////
       
   155 procedure GetParams;
       
   156 var c: integer;
       
   157 {$IFDEF DEBUGFILE}
       
   158     i: integer;
       
   159 begin
       
   160 for i:= 0 to ParamCount do
       
   161     AddFileLog(inttostr(i) + ': ' + ParamStr(i));
       
   162 {$ELSE}
       
   163 begin
       
   164 {$ENDIF}
       
   165 if ParamCount=6 then
       
   166    begin
       
   167    //TODO: сделать передачу через IPC
       
   168    val(ParamStr(1), cScreenWidth, c);
       
   169    val(ParamStr(2), cScreenHeight, c);
       
   170    Pathz[ptThemeCurrent]:= Pathz[ptThemes] + ParamStr(3)+'/';
       
   171    val(ParamStr(4), ipcPort, c);
       
   172    SetRandomParams(ParamStr(5), rndfillstr);
       
   173    cFullScreen:= ParamStr(6)[1] = '1'
       
   174    end else OutError(errmsgShouldntRun, true);
       
   175 end;
       
   176 
       
   177 procedure ShowMainWindow;
       
   178 var flags: Longword;
       
   179 begin
       
   180 flags:= SDL_HWSURFACE or SDL_DOUBLEBUF or SDL_HWACCEL;
       
   181 if cFullScreen then flags:= flags or SDL_FULLSCREEN
       
   182                else SDL_WM_SetCaption('Hedgewars', nil);
       
   183 SDLPrimSurface:= SDL_SetVideoMode(cScreenWidth, cScreenHeight, cBits, flags);
       
   184 TryDo(SDLPrimSurface <> nil, errmsgCreateSurface, true);
       
   185 PixelFormat:= SDLPrimSurface.format;
       
   186 SDL_ShowCursor(0);
       
   187 end;
       
   188 ////////////////////////////////////////////////////////////////////////////////
       
   189 /////////////////////////////// m a i n ////////////////////////////////////////
       
   190 ////////////////////////////////////////////////////////////////////////////////
       
   191 {$INCLUDE revision.inc}
       
   192 
       
   193 begin
       
   194 WriteLnToConsole('HedgeWars 0.1, svn '+cRevision);
       
   195 WriteLnToConsole('  -= by unC0Rr =-  ');
       
   196 GetParams;
       
   197 Randomize;
       
   198 InitGears;
       
   199 
       
   200 WriteToConsole('Init SDL... ');
       
   201 SDLTry(SDL_Init(SDL_INIT_VIDEO) >= 0, true);
       
   202 WriteLnToConsole(msgOK);
       
   203 
       
   204 WriteToConsole('Init SDL_ttf... ');
       
   205 SDLTry(TTF_Init >= 0, true);
       
   206 WriteLnToConsole(msgOK);
       
   207 
       
   208 ShowMainWindow;
       
   209 
       
   210 InitKbdKeyTable;
       
   211 InitIPC;
       
   212 WriteLnToConsole(msgGettingConfig);
       
   213 SendIPCAndWaitReply('C');        // запрос конфига игры
       
   214 InitTeams;
       
   215 
       
   216 if isSoundEnabled then InitSound;
       
   217 InitWorld;
       
   218 
       
   219 StoreInit;
       
   220 
       
   221 isDeveloperMode:= false;
       
   222 
       
   223 MainLoop
       
   224 
       
   225 end.