DEADSOFTWARE

fix android
[d2df-sdl.git] / src / game / g_main.pas
1 (* Copyright (C) Doom 2D: Forever Developers
2 *
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$INCLUDE ../shared/a_modes.inc}
16 unit g_main;
18 interface
20 procedure Main ();
21 procedure Init ();
22 procedure Release ();
23 procedure Update ();
24 procedure Draw ();
25 procedure KeyPress (K: Word);
26 procedure CharPress (C: AnsiChar);
28 var
29 GameDir: string;
30 DataDir: string;
31 MapsDir: string;
32 ModelsDir: string;
33 GameWAD: string;
34 LogFileName: string;
36 implementation
38 uses
39 {$INCLUDE ../nogl/noGLuses.inc}
40 {$IFDEF ENABLE_HOLMES}
41 g_holmes, sdlcarcass, fui_ctls, fui_wadread, fui_style, fui_gfx_gl,
42 {$ENDIF}
43 wadreader, e_log, g_window,
44 e_graphics, e_input, g_game, g_console, g_gui,
45 e_sound, g_options, g_sound, g_player, g_basic,
46 g_weapons, SysUtils, g_triggers, MAPDEF, g_map,
47 g_menu, g_language, g_net, g_touch, g_system, g_res_downloader,
48 utils, conbuf, envvars,
49 xparser;
52 var
53 charbuff: packed array [0..15] of AnsiChar;
55 procedure Main();
56 var
57 sdlflags: LongWord;
58 {$IF not DEFINED(HEADLESS) and DEFINED(ENABLE_HOLMES)}
59 flexloaded: Boolean;
60 {$ENDIF}
61 begin
62 e_InitWritelnDriver();
64 GetDir(0, GameDir);
65 MapsDir := GameDir + '/maps/';
66 DataDir := GameDir + '/data/';
67 ModelsDir := DataDir + 'models/';
68 GameWAD := DataDir + 'Game.wad';
70 e_InitLog(GameDir + '/' + LogFileName, TWriteMode.WM_NEWFILE);
72 e_WriteLog(
73 'Doom 2D: Forever version ' + GAME_VERSION +
74 ' proto ' + IntToStr(NET_PROTOCOL_VER),
75 TMsgType.Notify
76 );
77 e_WriteLog(
78 'Build date: ' + GAME_BUILDDATE + ' ' + GAME_BUILDTIME,
79 TMsgType.Notify
80 );
82 {$IFDEF HEADLESS}
83 conbufDumpToStdOut := true;
84 {$ENDIF}
85 e_WriteToStdOut := False; //{$IFDEF HEADLESS}True;{$ELSE}False;{$ENDIF}
87 e_InitInput;
89 sys_Init;
90 g_Options_Read(GameDir + '/' + CONFIG_FILENAME);
91 if sys_SetDisplayMode(gScreenWidth, gScreenHeight, gBPP, gFullScreen) = False then
92 raise Exception.Create('Failed to set videomode on startup.');
94 g_Console_SysInit;
95 e_WriteLog(gLanguage, TMsgType.Notify);
96 g_Language_Set(gLanguage);
98 {$IF not DEFINED(HEADLESS) and DEFINED(ENABLE_HOLMES)}
99 flexloaded := true;
100 if not fuiAddWad('flexui.wad') then
101 begin
102 if not fuiAddWad('./data/flexui.wad') then fuiAddWad('./flexui.wad');
103 end;
104 try
105 fuiGfxLoadFont('win8', 'flexui/fonts/win8.fuifont');
106 fuiGfxLoadFont('win14', 'flexui/fonts/win14.fuifont');
107 fuiGfxLoadFont('win16', 'flexui/fonts/win16.fuifont');
108 fuiGfxLoadFont('dos8', 'flexui/fonts/dos8.fuifont');
109 fuiGfxLoadFont('msx6', 'flexui/fonts/msx6.fuifont');
110 except on e: Exception do
111 begin
112 writeln('ERROR loading FlexUI fonts');
113 flexloaded := false;
114 //raise;
115 end;
116 else
117 begin
118 flexloaded := false;
119 //raise;
120 end;
121 end;
122 if (flexloaded) then
123 begin
124 try
125 e_LogWriteln('FlexUI: loading stylesheet...');
126 uiLoadStyles('flexui/widgets.wgs');
127 except on e: TParserException do
128 begin
129 writeln('ERROR at (', e.tokLine, ',', e.tokCol, '): ', e.message);
130 //raise;
131 flexloaded := false;
132 end;
133 else
134 begin
135 //raise;
136 flexloaded := false;
137 end;
138 end;
139 end;
140 g_holmes_imfunctional := not flexloaded;
142 if (not g_holmes_imfunctional) then
143 begin
144 uiInitialize();
145 uiContext.font := 'win14';
146 end;
148 if assigned(oglInitCB) then oglInitCB;
149 {$ENDIF}
151 //g_Res_CreateDatabases(); // it will be done before connecting to the server for the first time
153 e_WriteLog('Entering SDLMain', TMsgType.Notify);
155 {$WARNINGS OFF}
156 SDLMain();
157 {$WARNINGS ON}
159 {$IFDEF ENABLE_HOLMES}
160 if assigned(oglDeinitCB) then oglDeinitCB;
161 {$ENDIF}
163 sys_Final;
164 end;
166 procedure Init();
167 var
168 NoSound: Boolean;
169 begin
170 Randomize;
172 {$IFDEF HEADLESS}
173 {$IFDEF USE_SDLMIXER}
174 NoSound := False; // hope env has set SDL_AUDIODRIVER to dummy
175 {$ELSE}
176 NoSound := True; // FMOD backend will sort it out
177 {$ENDIF}
178 {$ELSE}
179 NoSound := False;
180 {$ENDIF}
182 g_Touch_Init;
184 (*
185 if (e_JoysticksAvailable > 0) then
186 e_WriteLog('Input: Joysticks available.', TMsgType.Notify)
187 else
188 e_WriteLog('Input: No Joysticks.', TMsgType.Notify);
189 *)
191 if (not gNoSound) then
192 begin
193 e_WriteLog('Initializing sound system', TMsgType.Notify);
194 e_InitSoundSystem(NoSound);
195 end;
197 e_WriteLog('Init game', TMsgType.Notify);
198 g_Game_Init();
200 FillChar(charbuff, sizeof(charbuff), ' ');
201 end;
204 procedure Release();
205 begin
206 e_WriteLog('Releasing engine', TMsgType.Notify);
207 e_ReleaseEngine();
209 e_WriteLog('Releasing Input', TMsgType.Notify);
210 e_ReleaseInput();
212 if not gNoSound then
213 begin
214 e_WriteLog('Releasing FMOD', TMsgType.Notify);
215 e_ReleaseSoundSystem();
216 end;
217 end;
220 procedure Update ();
221 begin
222 g_Game_Update();
223 end;
226 procedure Draw ();
227 begin
228 g_Game_Draw();
229 end;
232 function Translit (const S: AnsiString): AnsiString;
233 var
234 i: Integer;
235 begin
236 Result := S;
237 for i := 1 to Length(Result) do
238 begin
239 case Result[i] of
240 'É': Result[i] := 'Q';
241 'Ö': Result[i] := 'W';
242 'Ó': Result[i] := 'E';
243 'Ê': Result[i] := 'R';
244 'Å': Result[i] := 'T';
245 'Í': Result[i] := 'Y';
246 'Ã': Result[i] := 'U';
247 'Ø': Result[i] := 'I';
248 'Ù': Result[i] := 'O';
249 'Ç': Result[i] := 'P';
250 'Õ': Result[i] := '['; //Chr(219);
251 'Ú': Result[i] := ']'; //Chr(221);
252 'Ô': Result[i] := 'A';
253 'Û': Result[i] := 'S';
254 'Â': Result[i] := 'D';
255 'À': Result[i] := 'F';
256 'Ï': Result[i] := 'G';
257 'Ð': Result[i] := 'H';
258 'Î': Result[i] := 'J';
259 'Ë': Result[i] := 'K';
260 'Ä': Result[i] := 'L';
261 'Æ': Result[i] := ';'; //Chr(186);
262 'Ý': Result[i] := #39; //Chr(222);
263 'ß': Result[i] := 'Z';
264 '×': Result[i] := 'X';
265 'Ñ': Result[i] := 'C';
266 'Ì': Result[i] := 'V';
267 'È': Result[i] := 'B';
268 'Ò': Result[i] := 'N';
269 'Ü': Result[i] := 'M';
270 'Á': Result[i] := ','; //Chr(188);
271 'Þ': Result[i] := '.'; //Chr(190);
272 end;
273 end;
274 end;
277 function CheckCheat (ct: TStrings_Locale; eofs: Integer=0): Boolean;
278 var
279 ls1, ls2: string;
280 begin
281 ls1 := CheatEng[ct];
282 ls2 := Translit(CheatRus[ct]);
283 if length(ls1) = 0 then ls1 := '~';
284 if length(ls2) = 0 then ls2 := '~';
285 result :=
286 (Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)) = ls1) or
287 (Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))) = ls1) or
288 (Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)) = ls2) or
289 (Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))) = ls2);
291 if ct = I_GAME_CHEAT_JETPACK then
292 begin
293 e_WriteLog('ls1: ['+ls1+']', MSG_NOTIFY);
294 e_WriteLog('ls2: ['+ls2+']', MSG_NOTIFY);
295 e_WriteLog('bf0: ['+Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))+']', MSG_NOTIFY);
296 e_WriteLog('bf1: ['+Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)))+']', MSG_NOTIFY);
297 e_WriteLog('bf2: ['+Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))+']', MSG_NOTIFY);
298 e_WriteLog('bf3: ['+Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)))+']', MSG_NOTIFY);
299 end;
301 end;
304 procedure Cheat ();
305 const
306 CHEAT_DAMAGE = 500;
307 label
308 Cheated;
309 var
310 s, s2: string;
311 c: ShortString;
312 a: Integer;
313 begin
315 if (not gGameOn) or (not gCheats) or ((gGameSettings.GameType <> GT_SINGLE) and
316 (gGameSettings.GameMode <> GM_COOP) and (not gDebugMode))
317 or g_Game_IsNet then Exit;
319 if not gGameOn then exit;
320 if not conIsCheatsEnabled then exit;
322 s := 'SOUND_GAME_RADIO';
324 //
325 if CheckCheat(I_GAME_CHEAT_GODMODE) then
326 begin
327 if gPlayer1 <> nil then gPlayer1.GodMode := not gPlayer1.GodMode;
328 if gPlayer2 <> nil then gPlayer2.GodMode := not gPlayer2.GodMode;
329 goto Cheated;
330 end;
331 // RAMBO
332 if CheckCheat(I_GAME_CHEAT_WEAPONS) then
333 begin
334 if gPlayer1 <> nil then gPlayer1.AllRulez(False);
335 if gPlayer2 <> nil then gPlayer2.AllRulez(False);
336 goto Cheated;
337 end;
338 // TANK
339 if CheckCheat(I_GAME_CHEAT_HEALTH) then
340 begin
341 if gPlayer1 <> nil then gPlayer1.AllRulez(True);
342 if gPlayer2 <> nil then gPlayer2.AllRulez(True);
343 goto Cheated;
344 end;
345 // IDDQD
346 if CheckCheat(I_GAME_CHEAT_DEATH) then
347 begin
348 if gPlayer1 <> nil then gPlayer1.Damage(CHEAT_DAMAGE, 0, 0, 0, HIT_TRAP);
349 if gPlayer2 <> nil then gPlayer2.Damage(CHEAT_DAMAGE, 0, 0, 0, HIT_TRAP);
350 s := 'SOUND_MONSTER_HAHA';
351 goto Cheated;
352 end;
353 //
354 if CheckCheat(I_GAME_CHEAT_DOORS) then
355 begin
356 g_Triggers_OpenAll();
357 goto Cheated;
358 end;
359 // GOODBYE
360 if CheckCheat(I_GAME_CHEAT_NEXTMAP) then
361 begin
362 if gTriggers <> nil then
363 for a := 0 to High(gTriggers) do
364 if gTriggers[a].TriggerType = TRIGGER_EXIT then
365 begin
366 gExitByTrigger := True;
367 //g_Game_ExitLevel(gTriggers[a].Data.MapName);
368 g_Game_ExitLevel(gTriggers[a].tgcMap);
369 Break;
370 end;
371 goto Cheated;
372 end;
373 //
374 s2 := Copy(charbuff, 15, 2);
375 if CheckCheat(I_GAME_CHEAT_CHANGEMAP, 2) and (s2[1] >= '0') and (s2[1] <= '9') and (s2[2] >= '0') and (s2[2] <= '9') then
376 begin
377 if g_Map_Exist(MapsDir+gGameSettings.WAD+':\MAP'+s2) then
378 begin
379 c := 'MAP'+s2;
380 g_Game_ExitLevel(c);
381 end;
382 goto Cheated;
383 end;
384 //
385 if CheckCheat(I_GAME_CHEAT_FLY) then
386 begin
387 gFly := not gFly;
388 goto Cheated;
389 end;
390 // BULLFROG
391 if CheckCheat(I_GAME_CHEAT_JUMPS) then
392 begin
393 VEL_JUMP := 30-VEL_JUMP;
394 goto Cheated;
395 end;
396 // FORMULA1
397 if CheckCheat(I_GAME_CHEAT_SPEED) then
398 begin
399 MAX_RUNVEL := 32-MAX_RUNVEL;
400 goto Cheated;
401 end;
402 // CONDOM
403 if CheckCheat(I_GAME_CHEAT_SUIT) then
404 begin
405 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_SUIT);
406 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_SUIT);
407 goto Cheated;
408 end;
409 //
410 if CheckCheat(I_GAME_CHEAT_AIR) then
411 begin
412 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_OXYGEN);
413 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_OXYGEN);
414 goto Cheated;
415 end;
416 // PURELOVE
417 if CheckCheat(I_GAME_CHEAT_BERSERK) then
418 begin
419 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_MEDKIT_BLACK);
420 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_MEDKIT_BLACK);
421 goto Cheated;
422 end;
423 //
424 if CheckCheat(I_GAME_CHEAT_JETPACK) then
425 begin
426 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_JETPACK);
427 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_JETPACK);
428 goto Cheated;
429 end;
430 // CASPER
431 if CheckCheat(I_GAME_CHEAT_NOCLIP) then
432 begin
433 if gPlayer1 <> nil then gPlayer1.SwitchNoClip;
434 if gPlayer2 <> nil then gPlayer2.SwitchNoClip;
435 goto Cheated;
436 end;
437 //
438 if CheckCheat(I_GAME_CHEAT_NOTARGET) then
439 begin
440 if gPlayer1 <> nil then gPlayer1.NoTarget := not gPlayer1.NoTarget;
441 if gPlayer2 <> nil then gPlayer2.NoTarget := not gPlayer2.NoTarget;
442 goto Cheated;
443 end;
444 // INFERNO
445 if CheckCheat(I_GAME_CHEAT_NORELOAD) then
446 begin
447 if gPlayer1 <> nil then gPlayer1.NoReload := not gPlayer1.NoReload;
448 if gPlayer2 <> nil then gPlayer2.NoReload := not gPlayer2.NoReload;
449 goto Cheated;
450 end;
451 if CheckCheat(I_GAME_CHEAT_AIMLINE) then
452 begin
453 gAimLine := not gAimLine;
454 goto Cheated;
455 end;
456 if CheckCheat(I_GAME_CHEAT_AUTOMAP) then
457 begin
458 gShowMap := not gShowMap;
459 goto Cheated;
460 end;
461 Exit;
463 Cheated:
464 g_Sound_PlayEx(s);
465 end;
468 procedure KeyPress (K: Word);
469 {$IFNDEF HEADLESS}
470 var
471 Msg: g_gui.TMessage;
472 {$ENDIF}
473 begin
474 {$IFNDEF HEADLESS}
475 case K of
476 VK_ESCAPE: // <Esc>:
477 begin
478 if (g_ActiveWindow <> nil) then
479 begin
480 Msg.Msg := WM_KEYDOWN;
481 Msg.WParam := VK_ESCAPE;
482 g_ActiveWindow.OnMessage(Msg);
483 if (not g_Game_IsNet) and (g_ActiveWindow = nil) then g_Game_Pause(false); //Fn loves to do this
484 end
485 else if (gState <> STATE_FOLD) then
486 begin
487 if gGameOn or (gState = STATE_INTERSINGLE) or (gState = STATE_INTERCUSTOM) then
488 begin
489 g_Game_InGameMenu(True);
490 end
491 else if (gExit = 0) and (gState <> STATE_SLIST) then
492 begin
493 if (gState <> STATE_MENU) then
494 begin
495 if (NetMode <> NET_NONE) then
496 begin
497 g_Game_StopAllSounds(True);
498 g_Game_Free;
499 gState := STATE_MENU;
500 Exit;
501 end;
502 end;
503 g_GUI_ShowWindow('MainMenu');
504 g_Sound_PlayEx('MENU_OPEN');
505 end;
506 end;
507 end;
509 IK_F2, IK_F3, IK_F4, IK_F5, IK_F6, IK_F7, IK_F10:
510 begin // <F2> .. <F6> � <F12>
511 if gGameOn and (not gConsoleShow) and (not gChatShow) then
512 begin
513 while (g_ActiveWindow <> nil) do g_GUI_HideWindow(False);
514 if (not g_Game_IsNet) then g_Game_Pause(True);
515 case K of
516 IK_F2: g_Menu_Show_SaveMenu();
517 IK_F3: g_Menu_Show_LoadMenu();
518 IK_F4: g_Menu_Show_GameSetGame();
519 IK_F5: g_Menu_Show_OptionsVideo();
520 IK_F6: g_Menu_Show_OptionsSound();
521 IK_F7: g_Menu_Show_EndGameMenu();
522 IK_F10: g_Menu_Show_QuitGameMenu();
523 end;
524 end;
525 end;
527 else
528 begin
529 gJustChatted := False;
530 if gConsoleShow or gChatShow then
531 begin
532 g_Console_Control(K);
533 end
534 else if (g_ActiveWindow <> nil) then
535 begin
536 Msg.Msg := WM_KEYDOWN;
537 Msg.WParam := K;
538 g_ActiveWindow.OnMessage(Msg);
539 end
540 else if (gState = STATE_MENU) then
541 begin
542 g_GUI_ShowWindow('MainMenu');
543 g_Sound_PlayEx('MENU_OPEN');
544 end;
545 end;
546 end;
547 {$ENDIF}
548 end;
551 procedure CharPress (C: AnsiChar);
552 var
553 Msg: g_gui.TMessage;
554 a: Integer;
555 begin
556 if gConsoleShow or gChatShow then
557 begin
558 g_Console_Char(C)
559 end
560 else if (g_ActiveWindow <> nil) then
561 begin
562 Msg.Msg := WM_CHAR;
563 Msg.WParam := Ord(C);
564 g_ActiveWindow.OnMessage(Msg);
565 end
566 else
567 begin
568 for a := 0 to 14 do charbuff[a] := charbuff[a+1];
569 charbuff[15] := upcase1251(C);
570 Cheat();
571 end;
572 end;
575 end.