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