24dac52e2e76556c340db9ddd3595c1ec67d1370
1 (* Copyright (C) Doom 2D: Forever Developers
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.
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.
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/>.
15 {$INCLUDE ../shared/a_modes.inc}
27 procedure KeyPress (K
: Word);
28 procedure CharPress (C
: AnsiChar);
35 {--- Read-only dirs ---}
42 AllMapDirs
: SSArray
; // Maps + Megawads
44 {--- Read-Write dirs ---}
50 ScreenshotDirs
: SSArray
;
51 MapDownloadDirs
: SSArray
;
52 WadDownloadDirs
: SSArray
;
57 {$INCLUDE ../nogl/noGLuses.inc}
58 {$IFDEF ENABLE_HOLMES}
59 g_holmes
, sdlcarcass
, fui_ctls
, fui_wadread
, fui_style
, fui_gfx_gl
,
61 wadreader
, e_log
, g_window
,
62 e_graphics
, e_input
, g_game
, g_console
, g_gui
,
63 e_sound
, g_options
, g_sound
, g_player
, g_basic
,
64 g_weapons
, SysUtils
, g_triggers
, MAPDEF
, g_map
, e_res
,
65 g_menu
, g_language
, g_net
, g_touch
, g_system
, g_res_downloader
,
71 charbuff
: packed array [0..15] of AnsiChar;
74 var i
: Integer; rwdir
, rodir
: AnsiString;
76 procedure AddPath (var arr
: SSArray
; str
: AnsiString);
78 SetLength(arr
, Length(arr
) + 1);
79 arr
[High(arr
)] := ExpandFileName(str
)
82 procedure AddDef (var arr
: SSArray
; str
: AnsiString);
92 while i
< ParamCount
do
100 AddPath(LogDirs
, e_CatPath(rwdir
, ''));
101 AddPath(SaveDirs
, e_CatPath(rwdir
, 'data'));
102 AddPath(CacheDirs
, e_CatPath(rwdir
, 'data/cache'));
103 AddPath(ConfigDirs
, e_CatPath(rwdir
, ''));
104 AddPath(MapDownloadDirs
, e_CatPath(rwdir
, 'maps/downloads'));
105 AddPath(WadDownloadDirs
, e_CatPath(rwdir
, 'wads/downloads'));
106 AddPath(ScreenshotDirs
, e_CatPath(rwdir
, 'screenshots'));
108 AddPath(DataDirs
, e_CatPath(rwdir
, 'data'));
109 AddPath(ModelDirs
, e_CatPath(rwdir
, 'data/models'));
110 AddPath(MegawadDirs
, e_CatPath(rwdir
, 'maps/megawads'));
111 AddPath(MapDirs
, e_CatPath(rwdir
, 'maps'));
112 AddPath(WadDirs
, e_CatPath(rwdir
, 'wads'));
117 rodir
:= ParamStr(i
);
119 AddPath(DataDirs
, e_CatPath(rodir
, 'data'));
120 AddPath(ModelDirs
, e_CatPath(rodir
, 'data/models'));
121 AddPath(MegawadDirs
, e_CatPath(rodir
, 'maps/megawads'));
122 AddPath(MapDirs
, e_CatPath(rodir
, 'maps'));
123 AddPath(WadDirs
, e_CatPath(rodir
, 'wads'));
130 AddDef(DataDirs
, 'data');
131 AddDef(ModelDirs
, 'data/models');
132 AddDef(MegawadDirs
, 'maps/megawads');
133 AddDef(MapDirs
, 'maps');
134 AddDef(WadDirs
, 'wads');
136 AddDef(LogDirs
, '.');
137 AddDef(SaveDirs
, 'data');
138 AddDef(CacheDirs
, 'data/cache');
139 AddDef(ConfigDirs
, '.');
140 AddDef(MapDownloadDirs
, 'maps/downloads');
141 AddDef(WadDownloadDirs
, 'wad/downloads');
142 AddDef(ScreenshotDirs
, 'screenshots');
144 for i
:= 0 to High(MapDirs
) do
145 AddPath(AllMapDirs
, MapDirs
[i
]);
146 for i
:= 0 to High(MegawadDirs
) do
147 AddPath(AllMapDirs
, MegawadDirs
[i
]);
149 if LogFileName
= '' then
151 rwdir
:= e_GetDir(LogDirs
);
155 LogFileName
:= e_CatPath(rwdir
, 'Doom2DF_H.log');
157 LogFileName
:= e_Catpath(rwdir
, 'Doom2DF.log');
164 {$IFDEF ENABLE_HOLMES}
165 var flexloaded
: Boolean;
170 if LogFileName
<> '' then
171 e_InitLog(LogFileName
, TWriteMode
.WM_NEWFILE
);
172 e_InitWritelnDriver();
174 GameWAD
:= e_FindWad(DataDirs
, 'GAME');
175 assert(GameWad
<> '', 'GAME.WAD not installed?');
178 // e_InitLog(GameDir + '/' + LogFileName, TWriteMode.WM_NEWFILE);
181 'Doom 2D: Forever version ' + GAME_VERSION
+
182 ' proto ' + IntToStr(NET_PROTOCOL_VER
),
186 'Build date: ' + GAME_BUILDDATE
+ ' ' + GAME_BUILDTIME
,
191 conbufDumpToStdOut
:= true;
193 e_WriteToStdOut
:= False; //{$IFDEF HEADLESS}True;{$ELSE}False;{$ENDIF}
199 s
:= CONFIG_FILENAME
;
200 if e_FindResource(ConfigDirs
, s
) = true then
206 g_Options_SetDefault
;
207 g_Options_SetDefaultVideo
209 if sys_SetDisplayMode(gScreenWidth
, gScreenHeight
, gBPP
, gFullScreen
) = False then
210 raise Exception
.Create('Failed to set videomode on startup.');
213 e_WriteLog(gLanguage
, TMsgType
.Notify
);
214 g_Language_Set(gLanguage
);
216 {$IF not DEFINED(HEADLESS) and DEFINED(ENABLE_HOLMES)}
218 if not fuiAddWad('flexui.wad') then
220 if not fuiAddWad('./data/flexui.wad') then fuiAddWad('./flexui.wad');
223 fuiGfxLoadFont('win8', 'flexui/fonts/win8.fuifont');
224 fuiGfxLoadFont('win14', 'flexui/fonts/win14.fuifont');
225 fuiGfxLoadFont('win16', 'flexui/fonts/win16.fuifont');
226 fuiGfxLoadFont('dos8', 'flexui/fonts/dos8.fuifont');
227 fuiGfxLoadFont('msx6', 'flexui/fonts/msx6.fuifont');
228 except on e
: Exception
do
230 writeln('ERROR loading FlexUI fonts');
243 e_LogWriteln('FlexUI: loading stylesheet...');
244 uiLoadStyles('flexui/widgets.wgs');
245 except on e
: TParserException
do
247 writeln('ERROR at (', e
.tokLine
, ',', e
.tokCol
, '): ', e
.message);
258 g_holmes_imfunctional
:= not flexloaded
;
260 if (not g_holmes_imfunctional
) then
263 uiContext
.font
:= 'win14';
266 if assigned(oglInitCB
) then oglInitCB
;
269 //g_Res_CreateDatabases(); // it will be done before connecting to the server for the first time
271 e_WriteLog('Entering SDLMain', TMsgType
.Notify
);
277 {$IFDEF ENABLE_HOLMES}
278 if assigned(oglDeinitCB
) then oglDeinitCB
;
291 {$IFDEF USE_SDLMIXER}
292 NoSound
:= False; // hope env has set SDL_AUDIODRIVER to dummy
294 NoSound
:= True; // FMOD backend will sort it out
303 if (e_JoysticksAvailable > 0) then
304 e_WriteLog('Input: Joysticks available.', TMsgType.Notify)
306 e_WriteLog('Input: No Joysticks.', TMsgType.Notify);
309 if (not gNoSound
) then
311 e_WriteLog('Initializing sound system', TMsgType
.Notify
);
312 e_InitSoundSystem(NoSound
);
315 e_WriteLog('Init game', TMsgType
.Notify
);
318 FillChar(charbuff
, sizeof(charbuff
), ' ');
324 e_WriteLog('Releasing engine', TMsgType
.Notify
);
327 e_WriteLog('Releasing input', TMsgType
.Notify
);
332 e_WriteLog('Releasing sound', TMsgType
.Notify
);
333 e_ReleaseSoundSystem();
350 function Translit (const S
: AnsiString): AnsiString;
355 for i
:= 1 to Length(Result
) do
358 'É': Result
[i
] := 'Q';
359 'Ö': Result
[i
] := 'W';
360 'Ó': Result
[i
] := 'E';
361 'Ê': Result
[i
] := 'R';
362 'Å': Result
[i
] := 'T';
363 'Í': Result
[i
] := 'Y';
364 'Ã': Result
[i
] := 'U';
365 'Ø': Result
[i
] := 'I';
366 'Ù': Result
[i
] := 'O';
367 'Ç': Result
[i
] := 'P';
368 'Õ': Result
[i
] := '['; //Chr(219);
369 'Ú': Result
[i
] := ']'; //Chr(221);
370 'Ô': Result
[i
] := 'A';
371 'Û': Result
[i
] := 'S';
372 'Â': Result
[i
] := 'D';
373 'À': Result
[i
] := 'F';
374 'Ï': Result
[i
] := 'G';
375 'Ð': Result
[i
] := 'H';
376 'Î': Result
[i
] := 'J';
377 'Ë': Result
[i
] := 'K';
378 'Ä': Result
[i
] := 'L';
379 'Æ': Result
[i
] := ';'; //Chr(186);
380 'Ý': Result
[i
] := #39; //Chr(222);
381 'ß': Result
[i
] := 'Z';
382 '×': Result
[i
] := 'X';
383 'Ñ': Result
[i
] := 'C';
384 'Ì': Result
[i
] := 'V';
385 'È': Result
[i
] := 'B';
386 'Ò': Result
[i
] := 'N';
387 'Ü': Result
[i
] := 'M';
388 'Á': Result
[i
] := ','; //Chr(188);
389 'Þ': Result
[i
] := '.'; //Chr(190);
395 function CheckCheat (ct
: TStrings_Locale
; eofs
: Integer=0): Boolean;
400 ls2
:= Translit(CheatRus
[ct
]);
401 if length(ls1
) = 0 then ls1
:= '~';
402 if length(ls2
) = 0 then ls2
:= '~';
404 (Copy(charbuff
, 17-Length(ls1
)-eofs
, Length(ls1
)) = ls1
) or
405 (Translit(Copy(charbuff
, 17-Length(ls1
)-eofs
, Length(ls1
))) = ls1
) or
406 (Copy(charbuff
, 17-Length(ls2
)-eofs
, Length(ls2
)) = ls2
) or
407 (Translit(Copy(charbuff
, 17-Length(ls2
)-eofs
, Length(ls2
))) = ls2
);
409 if ct = I_GAME_CHEAT_JETPACK then
411 e_WriteLog('ls1: ['+ls1+']', MSG_NOTIFY);
412 e_WriteLog('ls2: ['+ls2+']', MSG_NOTIFY);
413 e_WriteLog('bf0: ['+Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))+']', MSG_NOTIFY);
414 e_WriteLog('bf1: ['+Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)))+']', MSG_NOTIFY);
415 e_WriteLog('bf2: ['+Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))+']', MSG_NOTIFY);
416 e_WriteLog('bf3: ['+Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)))+']', MSG_NOTIFY);
433 if (not gGameOn) or (not gCheats) or ((gGameSettings.GameType <> GT_SINGLE) and
434 (gGameSettings.GameMode <> GM_COOP) and (not gDebugMode))
435 or g_Game_IsNet then Exit;
437 if not gGameOn
then exit
;
438 if not conIsCheatsEnabled
then exit
;
440 s
:= 'SOUND_GAME_RADIO';
443 if CheckCheat(I_GAME_CHEAT_GODMODE
) then
445 if gPlayer1
<> nil then gPlayer1
.GodMode
:= not gPlayer1
.GodMode
;
446 if gPlayer2
<> nil then gPlayer2
.GodMode
:= not gPlayer2
.GodMode
;
450 if CheckCheat(I_GAME_CHEAT_WEAPONS
) then
452 if gPlayer1
<> nil then gPlayer1
.AllRulez(False);
453 if gPlayer2
<> nil then gPlayer2
.AllRulez(False);
457 if CheckCheat(I_GAME_CHEAT_HEALTH
) then
459 if gPlayer1
<> nil then gPlayer1
.AllRulez(True);
460 if gPlayer2
<> nil then gPlayer2
.AllRulez(True);
464 if CheckCheat(I_GAME_CHEAT_DEATH
) then
466 if gPlayer1
<> nil then gPlayer1
.Damage(CHEAT_DAMAGE
, 0, 0, 0, HIT_TRAP
);
467 if gPlayer2
<> nil then gPlayer2
.Damage(CHEAT_DAMAGE
, 0, 0, 0, HIT_TRAP
);
468 s
:= 'SOUND_MONSTER_HAHA';
472 if CheckCheat(I_GAME_CHEAT_DOORS
) then
474 g_Triggers_OpenAll();
478 if CheckCheat(I_GAME_CHEAT_NEXTMAP
) then
480 if gTriggers
<> nil then
481 for a
:= 0 to High(gTriggers
) do
482 if gTriggers
[a
].TriggerType
= TRIGGER_EXIT
then
484 gExitByTrigger
:= True;
485 //g_Game_ExitLevel(gTriggers[a].Data.MapName);
486 g_Game_ExitLevel(gTriggers
[a
].tgcMap
);
492 s2
:= Copy(charbuff
, 15, 2);
493 if CheckCheat(I_GAME_CHEAT_CHANGEMAP
, 2) and (s2
[1] >= '0') and (s2
[1] <= '9') and (s2
[2] >= '0') and (s2
[2] <= '9') then
495 if g_Map_Exist(gGameSettings
.WAD
+ ':\MAP' + s2
) then
503 if CheckCheat(I_GAME_CHEAT_FLY
) then
509 if CheckCheat(I_GAME_CHEAT_JUMPS
) then
511 VEL_JUMP
:= 30-VEL_JUMP
;
515 if CheckCheat(I_GAME_CHEAT_SPEED
) then
517 MAX_RUNVEL
:= 32-MAX_RUNVEL
;
521 if CheckCheat(I_GAME_CHEAT_SUIT
) then
523 if gPlayer1
<> nil then gPlayer1
.GiveItem(ITEM_SUIT
);
524 if gPlayer2
<> nil then gPlayer2
.GiveItem(ITEM_SUIT
);
528 if CheckCheat(I_GAME_CHEAT_AIR
) then
530 if gPlayer1
<> nil then gPlayer1
.GiveItem(ITEM_OXYGEN
);
531 if gPlayer2
<> nil then gPlayer2
.GiveItem(ITEM_OXYGEN
);
535 if CheckCheat(I_GAME_CHEAT_BERSERK
) then
537 if gPlayer1
<> nil then gPlayer1
.GiveItem(ITEM_MEDKIT_BLACK
);
538 if gPlayer2
<> nil then gPlayer2
.GiveItem(ITEM_MEDKIT_BLACK
);
542 if CheckCheat(I_GAME_CHEAT_JETPACK
) then
544 if gPlayer1
<> nil then gPlayer1
.GiveItem(ITEM_JETPACK
);
545 if gPlayer2
<> nil then gPlayer2
.GiveItem(ITEM_JETPACK
);
549 if CheckCheat(I_GAME_CHEAT_NOCLIP
) then
551 if gPlayer1
<> nil then gPlayer1
.SwitchNoClip
;
552 if gPlayer2
<> nil then gPlayer2
.SwitchNoClip
;
556 if CheckCheat(I_GAME_CHEAT_NOTARGET
) then
558 if gPlayer1
<> nil then gPlayer1
.NoTarget
:= not gPlayer1
.NoTarget
;
559 if gPlayer2
<> nil then gPlayer2
.NoTarget
:= not gPlayer2
.NoTarget
;
563 if CheckCheat(I_GAME_CHEAT_NORELOAD
) then
565 if gPlayer1
<> nil then gPlayer1
.NoReload
:= not gPlayer1
.NoReload
;
566 if gPlayer2
<> nil then gPlayer2
.NoReload
:= not gPlayer2
.NoReload
;
569 if CheckCheat(I_GAME_CHEAT_AIMLINE
) then
571 gAimLine
:= not gAimLine
;
574 if CheckCheat(I_GAME_CHEAT_AUTOMAP
) then
576 gShowMap
:= not gShowMap
;
586 procedure KeyPress (K
: Word);
596 if (g_ActiveWindow
<> nil) then
598 Msg
.Msg
:= WM_KEYDOWN
;
599 Msg
.WParam
:= VK_ESCAPE
;
600 g_ActiveWindow
.OnMessage(Msg
);
601 if (not g_Game_IsNet
) and (g_ActiveWindow
= nil) then g_Game_Pause(false); //Fn loves to do this
603 else if (gState
<> STATE_FOLD
) then
605 if gGameOn
or (gState
= STATE_INTERSINGLE
) or (gState
= STATE_INTERCUSTOM
) then
607 g_Game_InGameMenu(True);
609 else if (gExit
= 0) and (gState
<> STATE_SLIST
) then
611 if (gState
<> STATE_MENU
) then
613 if (NetMode
<> NET_NONE
) then
615 g_Game_StopAllSounds(True);
617 gState
:= STATE_MENU
;
621 g_GUI_ShowWindow('MainMenu');
622 g_Sound_PlayEx('MENU_OPEN');
627 IK_F2
, IK_F3
, IK_F4
, IK_F5
, IK_F6
, IK_F7
, IK_F10
:
628 begin // <F2> .. <F6> � <F12>
629 if gGameOn
and (not gConsoleShow
) and (not gChatShow
) then
631 while (g_ActiveWindow
<> nil) do g_GUI_HideWindow(False);
632 if (not g_Game_IsNet
) then g_Game_Pause(True);
634 IK_F2
: g_Menu_Show_SaveMenu();
635 IK_F3
: g_Menu_Show_LoadMenu();
636 IK_F4
: g_Menu_Show_GameSetGame();
637 IK_F5
: g_Menu_Show_OptionsVideo();
638 IK_F6
: g_Menu_Show_OptionsSound();
639 IK_F7
: g_Menu_Show_EndGameMenu();
640 IK_F10
: g_Menu_Show_QuitGameMenu();
647 gJustChatted
:= False;
648 if gConsoleShow
or gChatShow
then
650 g_Console_Control(K
);
652 else if (g_ActiveWindow
<> nil) then
654 Msg
.Msg
:= WM_KEYDOWN
;
656 g_ActiveWindow
.OnMessage(Msg
);
658 else if (gState
= STATE_MENU
) then
660 g_GUI_ShowWindow('MainMenu');
661 g_Sound_PlayEx('MENU_OPEN');
669 procedure CharPress (C
: AnsiChar);
674 if gConsoleShow
or gChatShow
then
678 else if (g_ActiveWindow
<> nil) then
681 Msg
.WParam
:= Ord(C
);
682 g_ActiveWindow
.OnMessage(Msg
);
686 for a
:= 0 to 14 do charbuff
[a
] := charbuff
[a
+1];
687 charbuff
[15] := upcase1251(C
);