hedgewars/hwengine.dpr
changeset 2326 0ddf641fddee
parent 2325 b07e87f6430f
child 2327 4832b77ec958
equal deleted inserted replaced
2325:b07e87f6430f 2326:0ddf641fddee
     1  (*
       
     2  * Hedgewars, a free turn based strategy game
       
     3  * Copyright (c) 2004-2007 Andrey Korotaev <unC0Rr@gmail.com>
       
     4  *
       
     5  * This program is free software; you can redistribute it and/or modify
       
     6  * it under the terms of the GNU General Public License as published by
       
     7  * the Free Software Foundation; version 2 of the License
       
     8  *
       
     9  * This program is distributed in the hope that it will be useful,
       
    10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
       
    11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
       
    12  * GNU General Public License for more details.
       
    13  *
       
    14  * You should have received a copy of the GNU General Public License
       
    15  * along with this program; if not, write to the Free Software
       
    16  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
       
    17  *)
       
    18 
       
    19 {$IFNDEF FPC}
       
    20 WriteLn('Only Freepascal supported');
       
    21 {$ENDIF}
       
    22 
       
    23 program hwengine;
       
    24 uses
       
    25 	SDLh in 'SDLh.pas',
       
    26 {$IFDEF GLES11}
       
    27 	gles11,
       
    28 {$ELSE}
       
    29 	GL,
       
    30 {$ENDIF}
       
    31 	uConsts in 'uConsts.pas',
       
    32 	uGame in 'uGame.pas',
       
    33 	uMisc in 'uMisc.pas',
       
    34 	uStore in 'uStore.pas',
       
    35 	uWorld in 'uWorld.pas',
       
    36 	uIO in 'uIO.pas',
       
    37 	uGears in 'uGears.pas',
       
    38 	uVisualGears in 'uVisualGears.pas',
       
    39 	uConsole in 'uConsole.pas',
       
    40 	uKeys in 'uKeys.pas',
       
    41 	uTeams in 'uTeams.pas',
       
    42 	uSound in 'uSound.pas',
       
    43 	uRandom in 'uRandom.pas',
       
    44 	uAI in 'uAI.pas',
       
    45 	uAIMisc in 'uAIMisc.pas',
       
    46 	uAIAmmoTests in 'uAIAmmoTests.pas',
       
    47 	uAIActions in 'uAIActions.pas',
       
    48 	uCollisions in 'uCollisions.pas',
       
    49 	uLand in 'uLand.pas',
       
    50 	uLandTemplates in 'uLandTemplates.pas',
       
    51 	uLandObjects in 'uLandObjects.pas',
       
    52 	uLandGraphics in 'uLandGraphics.pas',
       
    53 	uLocale in 'uLocale.pas',
       
    54 	uAmmos in 'uAmmos.pas',
       
    55 	uSHA in 'uSHA.pas',
       
    56 	uFloat in 'uFloat.pas',
       
    57 	uStats in 'uStats.pas',
       
    58 	uChat in 'uChat.pas',
       
    59 	uLandTexture in 'uLandTexture.pas';
       
    60 
       
    61 {$INCLUDE options.inc}
       
    62 
       
    63 // also: GSHandlers.inc
       
    64 //       CCHandlers.inc
       
    65 //       HHHandlers.inc
       
    66 //       SinTable.inc
       
    67 //       proto.inc
       
    68 
       
    69 var recordFileName : shortstring = '';
       
    70 
       
    71 procedure OnDestroy; forward;
       
    72 
       
    73 ////////////////////////////////
       
    74 procedure DoTimer(Lag: LongInt);
       
    75 {$IFNDEF IPHONEOS}
       
    76 var s: string;
       
    77 {$ENDIF}
       
    78 begin
       
    79 inc(RealTicks, Lag);
       
    80 
       
    81 case GameState of
       
    82 	gsLandGen: begin
       
    83 			GenMap;
       
    84 			GameState:= gsStart;
       
    85 			end;
       
    86 	gsStart: begin
       
    87 			if HasBorder then DisableSomeWeapons;
       
    88 			AddClouds;
       
    89 			AssignHHCoords;
       
    90 			AddMiscGears;
       
    91 			StoreLoad;
       
    92             InitWorld;
       
    93 			ResetKbd;
       
    94 			SoundLoad;
       
    95 			if GameType = gmtSave then
       
    96 				begin
       
    97 				isSEBackup:= isSoundEnabled;
       
    98 				isSoundEnabled:= false
       
    99 				end;
       
   100 			FinishProgress;
       
   101 			PlayMusic;
       
   102 			SetScale(zoom);
       
   103 			GameState:= gsGame
       
   104 			end;
       
   105 	gsConfirm,
       
   106 	gsGame: begin
       
   107 			DrawWorld(Lag); // never place between ProcessKbd and DoGameTick - bugs due to /put cmd and isCursorVisible
       
   108 			ProcessKbd;
       
   109 			DoGameTick(Lag);
       
   110 			ProcessVisualGears(Lag);
       
   111 			end;
       
   112 	gsChat: begin
       
   113 			DrawWorld(Lag);
       
   114 			DoGameTick(Lag);
       
   115 			ProcessVisualGears(Lag);
       
   116 			end;
       
   117 	gsExit: begin
       
   118 			OnDestroy;
       
   119 			end;
       
   120 	end;
       
   121 
       
   122 SDL_GL_SwapBuffers();
       
   123 {$IFNDEF IPHONEOS}
       
   124 //not going to make captures on the iPhone
       
   125 if flagMakeCapture then
       
   126 	begin
       
   127 	flagMakeCapture:= false;
       
   128 	s:= 'hw_' + cSeed + '_' + inttostr(GameTicks) + '.tga';
       
   129 	WriteLnToConsole('Saving ' + s);
       
   130 	MakeScreenshot(s);
       
   131 //	SDL_SaveBMP_RW(SDLPrimSurface, SDL_RWFromFile(Str2PChar(s), 'wb'), 1)
       
   132 	end;
       
   133 {$ENDIF}
       
   134 end;
       
   135 
       
   136 ////////////////////
       
   137 procedure OnDestroy;
       
   138 begin
       
   139 {$IFDEF DEBUGFILE}AddFileLog('Freeing resources...');{$ENDIF}
       
   140 if isSoundEnabled then ReleaseSound;
       
   141 StoreRelease;
       
   142 FreeLand;
       
   143 SendKB;
       
   144 CloseIPC;
       
   145 TTF_Quit;
       
   146 SDL_Quit;
       
   147 halt
       
   148 end;
       
   149 
       
   150 ////////////////////////////////
       
   151 procedure Resize(w, h: LongInt);
       
   152 begin
       
   153 cScreenWidth:= w;
       
   154 cScreenHeight:= h;
       
   155 if cFullScreen then
       
   156 	ParseCommand('/fullscr 1', true)
       
   157 else
       
   158 	ParseCommand('/fullscr 0', true);
       
   159 end;
       
   160 
       
   161 ///////////////////
       
   162 procedure MainLoop;
       
   163 var PrevTime,
       
   164     CurrTime: Longword;
       
   165     event: TSDL_Event;
       
   166 begin
       
   167 PrevTime:= SDL_GetTicks;
       
   168 repeat
       
   169 while SDL_PollEvent(@event) <> 0 do
       
   170 	case event.type_ of
       
   171 	{$IFDEF IPHONEOS}
       
   172 		SDL_MOUSEMOTION: WriteLnToConsole('mouse number ' + inttostr(SDL_SelectMouse(event.motion.which)) + ' over ' + inttostr(SDL_GetNumMice()));
       
   173 	{$ELSE}
       
   174 		SDL_KEYDOWN: if GameState = gsChat then KeyPressChat(event.key.keysym.unicode);
       
   175 	{$ENDIF}
       
   176 		SDL_ACTIVEEVENT: if (event.active.state and SDL_APPINPUTFOCUS) <> 0 then
       
   177 				cHasFocus:= event.active.gain = 1;
       
   178 		//SDL_VIDEORESIZE: Resize(max(event.resize.w, 600), max(event.resize.h, 450));
       
   179 		SDL_QUITEV: isTerminated:= true
       
   180 		end;
       
   181 CurrTime:= SDL_GetTicks;
       
   182 if PrevTime + cTimerInterval <= CurrTime then
       
   183    begin
       
   184    DoTimer(CurrTime - PrevTime);
       
   185    PrevTime:= CurrTime
       
   186    end else SDL_Delay(1);
       
   187 IPCCheckSock
       
   188 until isTerminated
       
   189 end;
       
   190 
       
   191 /////////////////////
       
   192 procedure DisplayUsage;
       
   193 begin
       
   194 	WriteLn('Wrong argument format: correct configurations is');
       
   195 	WriteLn();
       
   196 	WriteLn('  hwengine <path to data folder> <path to replay file> [option]');
       
   197 	WriteLn();
       
   198 	WriteLn('where [option] must be specified either as');
       
   199 	WriteLn(' --set-video [screen width] [screen height] [color dept]');
       
   200 	WriteLn(' --set-audio [volume] [enable music] [enable sounds]');
       
   201 	WriteLn(' --set-other [language file] [full screen] [show FPS]');
       
   202 	WriteLn(' --set-multimedia [screen height] [screen width] [color dept] [volume] [enable music] [enable sounds] [language file] [full screen]');
       
   203 	WriteLn(' --set-everything [screen height] [screen width] [color dept] [volume] [enable music] [enable sounds] [language file] [full screen] [show FPS] [alternate damage] [timer value] [reduced quality]');
       
   204 	WriteLn();
       
   205 	WriteLn('Read documentation online at http://www.hedgewars.org/node/1465 for more information');
       
   206 	halt(1);
       
   207 end;
       
   208 
       
   209 ////////////////////
       
   210 procedure GetParams;
       
   211 var
       
   212 {$IFDEF DEBUGFILE}
       
   213     i: LongInt;
       
   214 {$ENDIF}
       
   215     p: TPathType;
       
   216 begin
       
   217 {$IFDEF DEBUGFILE}
       
   218 AddFileLog('Prefix: "' + PathPrefix +'"');
       
   219 for i:= 0 to ParamCount do
       
   220     AddFileLog(inttostr(i) + ': ' + ParamStr(i));
       
   221 {$ENDIF}
       
   222 
       
   223 case ParamCount of
       
   224  16: begin
       
   225      val(ParamStr(2), cScreenWidth);
       
   226      val(ParamStr(3), cScreenHeight);
       
   227      cInitWidth:= cScreenWidth;
       
   228      cInitHeight:= cScreenHeight;
       
   229      cBitsStr:= ParamStr(4);
       
   230      val(cBitsStr, cBits);
       
   231      val(ParamStr(5), ipcPort);
       
   232      cFullScreen:= ParamStr(6) = '1';
       
   233      isSoundEnabled:= ParamStr(7) = '1';
       
   234      cLocaleFName:= ParamStr(8);
       
   235      val(ParamStr(9), cInitVolume);
       
   236      val(ParamStr(10), cTimerInterval);
       
   237      PathPrefix:= ParamStr(11);
       
   238      cShowFPS:= ParamStr(12) = '1';
       
   239      cAltDamage:= ParamStr(13) = '1';
       
   240      UserNick:= DecodeBase64(ParamStr(14));
       
   241      isMusicEnabled:= ParamStr(15) = '1';
       
   242      cReducedQuality:= ParamStr(16) = '1';
       
   243      for p:= Succ(Low(TPathType)) to High(TPathType) do
       
   244          if p <> ptMapCurrent then Pathz[p]:= PathPrefix + '/' + Pathz[p]
       
   245      end;
       
   246 	 {$IFDEF IPHONEOS}
       
   247   0: begin
       
   248         PathPrefix:= 'hedgewars/Data';
       
   249 		recordFileName:= 'hedgewars/save.hws';
       
   250 		val('320', cScreenWidth);
       
   251 		val('480', cScreenHeight);
       
   252 		cInitWidth:= cScreenWidth;
       
   253 		cInitHeight:= cScreenHeight;
       
   254 		cBitsStr:= '32';
       
   255 		val(cBitsStr, cBits);
       
   256 		val('100', cInitVolume);
       
   257 		isMusicEnabled:= false;
       
   258 		isSoundEnabled:= false;
       
   259 		cLocaleFName:= 'en.txt';
       
   260 		cFullScreen:= false;
       
   261 		cAltDamage:= false;
       
   262 		cShowFPS:= false;
       
   263 		val('8', cTimerInterval);
       
   264 		cReducedQuality:= false;
       
   265 
       
   266         for p:= Succ(Low(TPathType)) to High(TPathType) do
       
   267 			if p <> ptMapCurrent then Pathz[p]:= PathPrefix + '/' + Pathz[p]
       
   268      end;
       
   269 	 {$ENDIF}
       
   270   3: begin
       
   271      val(ParamStr(2), ipcPort);
       
   272      GameType:= gmtLandPreview;
       
   273      if ParamStr(3) <> 'landpreview' then OutError(errmsgShouldntRun, true);
       
   274      end;
       
   275   2: begin
       
   276 		PathPrefix:= ParamStr(1);
       
   277 		recordFileName:= ParamStr(2);
       
   278 	 
       
   279 		for p:= Succ(Low(TPathType)) to High(TPathType) do
       
   280 			if p <> ptMapCurrent then Pathz[p]:= PathPrefix + '/' + Pathz[p]
       
   281 	end;
       
   282   6: begin
       
   283 		PathPrefix:= ParamStr(1);
       
   284 		recordFileName:= ParamStr(2);
       
   285 	 
       
   286 		if ParamStr(3) = '--set-video'	then
       
   287 		begin
       
   288 			val(ParamStr(4), cScreenWidth);
       
   289 			val(ParamStr(5), cScreenHeight);
       
   290 			cInitWidth:= cScreenWidth;
       
   291 			cInitHeight:= cScreenHeight;
       
   292 			cBitsStr:= ParamStr(6);
       
   293 			val(cBitsStr, cBits);
       
   294 		end
       
   295 		else
       
   296 		begin
       
   297 			if ParamStr(3) = '--set-audio' then
       
   298 			begin
       
   299 				val(ParamStr(4), cInitVolume);
       
   300 				isMusicEnabled:= ParamStr(5) = '1';
       
   301 				isSoundEnabled:= ParamStr(6) = '1';
       
   302 			end
       
   303 			else
       
   304 			begin
       
   305 				if ParamStr(3) = '--set-other' then
       
   306 				begin
       
   307 					cLocaleFName:= ParamStr(4);
       
   308 					cFullScreen:= ParamStr(5) = '1';
       
   309 					cShowFPS:= ParamStr(6) = '1';
       
   310 				end
       
   311 				else DisplayUsage;
       
   312 			end
       
   313 		end;
       
   314 		
       
   315 		for p:= Succ(Low(TPathType)) to High(TPathType) do
       
   316 			if p <> ptMapCurrent then Pathz[p]:= PathPrefix + '/' + Pathz[p]
       
   317 	end;
       
   318  11: begin
       
   319 		PathPrefix:= ParamStr(1);
       
   320 		recordFileName:= ParamStr(2);
       
   321 	
       
   322 		if ParamStr(3) = '--set-multimedia' then
       
   323 		begin
       
   324 			val(ParamStr(4), cScreenWidth);
       
   325 			val(ParamStr(5), cScreenHeight);
       
   326 			cInitWidth:= cScreenWidth;
       
   327 			cInitHeight:= cScreenHeight;
       
   328 			cBitsStr:= ParamStr(6);
       
   329 			val(cBitsStr, cBits);
       
   330 			val(ParamStr(7), cInitVolume);
       
   331 			isMusicEnabled:= ParamStr(8) = '1';
       
   332 			isSoundEnabled:= ParamStr(9) = '1';
       
   333 			cLocaleFName:= ParamStr(10);
       
   334 			cFullScreen:= ParamStr(11) = '1';
       
   335 		end
       
   336 		else DisplayUsage;
       
   337 		
       
   338 		for p:= Succ(Low(TPathType)) to High(TPathType) do
       
   339 			if p <> ptMapCurrent then Pathz[p]:= PathPrefix + '/' + Pathz[p]
       
   340 	end;
       
   341  15: begin
       
   342 		PathPrefix:= ParamStr(1);
       
   343 		recordFileName:= ParamStr(2);
       
   344 		if ParamStr(3) = '--set-everything' then
       
   345 		begin
       
   346 			val(ParamStr(4), cScreenWidth);
       
   347 			val(ParamStr(5), cScreenHeight);
       
   348 			cInitWidth:= cScreenWidth;
       
   349 			cInitHeight:= cScreenHeight;
       
   350 			cBitsStr:= ParamStr(6);
       
   351 			val(cBitsStr, cBits);
       
   352 			val(ParamStr(7), cInitVolume);
       
   353 			isMusicEnabled:= ParamStr(8) = '1';
       
   354 			isSoundEnabled:= ParamStr(9) = '1';
       
   355 			cLocaleFName:= ParamStr(10);
       
   356 			cFullScreen:= ParamStr(11) = '1';
       
   357 			cAltDamage:= ParamStr(12) = '1';
       
   358 			cShowFPS:= ParamStr(13) = '1';
       
   359 			val(ParamStr(14), cTimerInterval);
       
   360 			cReducedQuality:= ParamStr(15) = '1';
       
   361 		end
       
   362 		else DisplayUsage;
       
   363 		
       
   364 		for p:= Succ(Low(TPathType)) to High(TPathType) do
       
   365 			if p <> ptMapCurrent then Pathz[p]:= PathPrefix + '/' + Pathz[p]
       
   366 	end;
       
   367 	else DisplayUsage;
       
   368 	end;
       
   369 end;
       
   370 
       
   371 /////////////////////////
       
   372 procedure ShowMainWindow;
       
   373 begin
       
   374 if cFullScreen then ParseCommand('fullscr 1', true)
       
   375                else ParseCommand('fullscr 0', true);
       
   376 SDL_ShowCursor(0)
       
   377 end;
       
   378 
       
   379 ///////////////
       
   380 procedure Game;
       
   381 var s: shortstring;
       
   382 begin
       
   383 WriteToConsole('Init SDL... ');
       
   384 SDLTry(SDL_Init(SDL_INIT_VIDEO) >= 0, true);
       
   385 WriteLnToConsole(msgOK);
       
   386 
       
   387 SDL_EnableUNICODE(1);
       
   388 
       
   389 WriteToConsole('Init SDL_ttf... ');
       
   390 SDLTry(TTF_Init <> -1, true);
       
   391 WriteLnToConsole(msgOK);
       
   392 
       
   393 ShowMainWindow;
       
   394 
       
   395 InitKbdKeyTable;
       
   396 
       
   397 if recordFileName = '' then InitIPC;
       
   398 WriteLnToConsole(msgGettingConfig);
       
   399 
       
   400 if cLocaleFName <> 'en.txt' then
       
   401 	LoadLocale(Pathz[ptLocale] + '/en.txt');
       
   402 LoadLocale(Pathz[ptLocale] + '/' + cLocaleFName);
       
   403 
       
   404 if recordFileName = '' then
       
   405 	SendIPCAndWaitReply('C')        // ask for game config
       
   406 else
       
   407  begin
       
   408 	LoadRecordFromFile(recordFileName);
       
   409  end;
       
   410 
       
   411 s:= 'eproto ' + inttostr(cNetProtoVersion);
       
   412 SendIPCRaw(@s[0], Length(s) + 1); // send proto version
       
   413 
       
   414 InitTeams;
       
   415 AssignStores;
       
   416 
       
   417 if isSoundEnabled then InitSound;
       
   418 
       
   419 StoreInit;
       
   420 
       
   421 isDeveloperMode:= false;
       
   422 
       
   423 TryDo(InitStepsFlags = cifAllInited,
       
   424       'Some parameters not set (flags = ' + inttostr(InitStepsFlags) + ')',
       
   425       true);
       
   426 
       
   427 MainLoop
       
   428 end;
       
   429 
       
   430 /////////////////////////
       
   431 procedure GenLandPreview;
       
   432 var Preview: TPreview;
       
   433 	h: byte;
       
   434 begin
       
   435 InitIPC;
       
   436 IPCWaitPongEvent;
       
   437 TryDo(InitStepsFlags = cifRandomize,
       
   438       'Some parameters not set (flags = ' + inttostr(InitStepsFlags) + ')',
       
   439       true);
       
   440 
       
   441 Preview:= GenPreview;
       
   442 WriteLnToConsole('Sending preview...');
       
   443 SendIPCRaw(@Preview, sizeof(Preview));
       
   444 h:= MaxHedgehogs;
       
   445 SendIPCRaw(@h, sizeof(h));
       
   446 WriteLnToConsole('Preview sent, disconnect');
       
   447 CloseIPC
       
   448 end;
       
   449 
       
   450 ////////////////////////////////////////////////////////////////////////////////
       
   451 /////////////////////////////// m a i n ////////////////////////////////////////
       
   452 ////////////////////////////////////////////////////////////////////////////////
       
   453 
       
   454 begin
       
   455 WriteLnToConsole('Hedgewars ' + cVersionString + ' engine');
       
   456 GetParams;
       
   457 // FIXME -  hack in font with support for CJK
       
   458 if (cLocaleFName = 'zh_CN.txt') or (cLocaleFName = 'zh_TW.txt') or (cLocaleFName = 'ja.txt') then
       
   459     Fontz:= FontzCJK;
       
   460 
       
   461 Randomize;
       
   462 
       
   463 if GameType = gmtLandPreview then GenLandPreview
       
   464                              else Game
       
   465 end.
       
   466