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, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 {$INCLUDE ../shared/a_modes.inc}
26 procedure KeyPress (K
: Word);
27 procedure CharPress (C
: AnsiChar);
40 {$INCLUDE ../nogl/noGLuses.inc}
44 {$IFDEF USE_LIBSOCKET}
47 {$IFDEF ENABLE_HOLMES}
48 g_holmes
, fui_wadread
, fui_style
, fui_gfx_gl
,
50 SDL2
, wadreader
, e_log
, g_window
,
51 e_graphics
, e_input
, g_game
, g_console
, g_gui
,
52 e_sound
, g_options
, g_sound
, g_player
, g_basic
,
53 g_weapons
, SysUtils
, g_triggers
, MAPDEF
, g_map
,
54 g_menu
, g_language
, g_net
, g_touch
,
55 utils
, conbuf
, envvars
,
60 charbuff
: packed array [0..15] of AnsiChar;
65 {$IF not DEFINED(HEADLESS) and DEFINED(ENABLE_HOLMES)}
69 e_InitWritelnDriver();
72 MapsDir
:= GameDir
+ '/maps/';
73 DataDir
:= GameDir
+ '/data/';
74 ModelsDir
:= DataDir
+ 'models/';
75 GameWAD
:= DataDir
+ 'Game.wad';
77 e_InitLog(GameDir
+ '/' + LOG_FILENAME
, TWriteMode
.WM_NEWFILE
);
80 'Doom 2D: Forever version ' + GAME_VERSION
+
81 ' proto ' + IntToStr(NET_PROTOCOL_VER
),
85 'Build date: ' + GAME_BUILDDATE
+ ' ' + GAME_BUILDTIME
,
90 sdlflags
:= sock_init
;
91 {$IFDEF USE_SDL2ALLEGRO}
93 init_userSuppliedTimerTick
;
95 e_WriteLog('Wattcp Init: (' + IntToStr(sdlflags
) + ') ' + sock_init_err(sdlflags
), TMsgType
.Notify
);
96 e_WriteLog('Wattcp Version: ' + wattcpVersion
, TMsgType
.Notify
);
97 e_WriteLog('Wattcp Capabilities: ' + wattcpCapabilities
, TMsgType
.Notify
);
98 e_WriteLog('Wattcp IP: ' +
99 IntToStr(my_ip_addr
div 16777216 mod 256) + '.' +
100 IntToStr(my_ip_addr
div 65536 mod 256) + '.' +
101 IntToStr(my_ip_addr
div 256 mod 256) + '.' +
102 IntToStr(my_ip_addr
mod 256),
106 {$IFDEF USE_LIBSOCKET}
107 sdlflags
:= __lsck_init
;
108 e_WriteLog('libsocket Init: (' + IntToStr(sdlflags
) + ') ' + lsck_strerror(sdlflags
), TMsgType
.Notify
);
109 e_WriteLog('libsocket Version: ' + __lsck_get_version
, TMsgType
.Notify
);
113 conbufDumpToStdOut
:= true;
115 e_WriteToStdOut
:= False; //{$IFDEF HEADLESS}True;{$ELSE}False;{$ENDIF}
118 {$IFDEF USE_SDLMIXER}
119 sdlflags
:= SDL_INIT_TIMER
or SDL_INIT_AUDIO
or $00004000;
120 // HACK: shit this into env and hope for the best
121 SetEnvVar('SDL_AUDIODRIVER', 'dummy');
123 sdlflags
:= SDL_INIT_TIMER
or $00004000;
126 {$IFDEF USE_SDLMIXER}
127 {*sdlflags := SDL_INIT_EVERYTHING;*}
128 sdlflags
:= SDL_INIT_JOYSTICK
or SDL_INIT_TIMER
or SDL_INIT_VIDEO
;
130 sdlflags
:= SDL_INIT_JOYSTICK
or SDL_INIT_TIMER
or SDL_INIT_VIDEO
;
134 SDL_SetHint(SDL_HINT_ACCELEROMETER_AS_JOYSTICK
, '0');
136 if SDL_Init(sdlflags
) < 0 then
137 raise Exception
.Create('SDL: Init failed: ' + SDL_GetError());
139 e_WriteLog('Read config file', TMsgType
.Notify
);
140 g_Options_Read(GameDir
+ '/' + CONFIG_FILENAME
);
142 //GetSystemDefaultLCID()
144 //e_WriteLog('Read language file', MSG_NOTIFY);
145 //g_Language_Load(DataDir + gLanguage + '.txt');
146 e_WriteLog(gLanguage
, TMsgType
.Notify
);
147 g_Language_Set(gLanguage
);
151 SDL_StartTextInput();
155 {$IF not DEFINED(HEADLESS) and DEFINED(ENABLE_HOLMES)}
157 if not fuiAddWad('flexui.wad') then
159 if not fuiAddWad('./data/flexui.wad') then fuiAddWad('./flexui.wad');
162 fuiGfxLoadFont('win8', 'flexui/fonts/win8.fuifont');
163 fuiGfxLoadFont('win14', 'flexui/fonts/win14.fuifont');
164 fuiGfxLoadFont('win16', 'flexui/fonts/win16.fuifont');
165 fuiGfxLoadFont('dos8', 'flexui/fonts/dos8.fuifont');
166 fuiGfxLoadFont('msx6', 'flexui/fonts/msx6.fuifont');
167 except on e
: Exception
do
169 writeln('ERROR loading FlexUI fonts');
182 e_LogWriteln('FlexUI: loading stylesheet...');
183 uiLoadStyles('flexui/widgets.wgs');
184 except on e
: TParserException
do
186 writeln('ERROR at (', e
.tokLine
, ',', e
.tokCol
, '): ', e
.message);
197 g_holmes_imfunctional
:= not flexloaded
;
200 e_WriteLog('Entering SDLMain', TMsgType
.Notify
);
210 e_WriteLog('Releasing SDL', TMsgType
.Notify
);
221 {$IFDEF USE_SDLMIXER}
222 NoSound
:= False; // hope env has set SDL_AUDIODRIVER to dummy
224 NoSound
:= True; // FMOD backend will sort it out
230 e_WriteLog('Init Input', TMsgType
.Notify
);
234 if (e_JoysticksAvailable
> 0) then
235 e_WriteLog('Input: Joysticks available.', TMsgType
.Notify
)
237 e_WriteLog('Input: No Joysticks.', TMsgType
.Notify
);
239 if (not gNoSound
) then
241 e_WriteLog('Initializing sound system', TMsgType
.Notify
);
242 e_InitSoundSystem(NoSound
);
245 e_WriteLog('Init game', TMsgType
.Notify
);
248 FillChar(charbuff
, sizeof(charbuff
), ' ');
254 e_WriteLog('Releasing engine', TMsgType
.Notify
);
257 e_WriteLog('Releasing Input', TMsgType
.Notify
);
262 e_WriteLog('Releasing FMOD', TMsgType
.Notify
);
263 e_ReleaseSoundSystem();
280 function Translit (const S
: AnsiString): AnsiString;
285 for i
:= 1 to Length(Result
) do
288 'É': Result
[i
] := 'Q';
289 'Ö': Result
[i
] := 'W';
290 'Ó': Result
[i
] := 'E';
291 'Ê': Result
[i
] := 'R';
292 'Å': Result
[i
] := 'T';
293 'Í': Result
[i
] := 'Y';
294 'Ã': Result
[i
] := 'U';
295 'Ø': Result
[i
] := 'I';
296 'Ù': Result
[i
] := 'O';
297 'Ç': Result
[i
] := 'P';
298 'Õ': Result
[i
] := '['; //Chr(219);
299 'Ú': Result
[i
] := ']'; //Chr(221);
300 'Ô': Result
[i
] := 'A';
301 'Û': Result
[i
] := 'S';
302 'Â': Result
[i
] := 'D';
303 'À': Result
[i
] := 'F';
304 'Ï': Result
[i
] := 'G';
305 'Ð': Result
[i
] := 'H';
306 'Î': Result
[i
] := 'J';
307 'Ë': Result
[i
] := 'K';
308 'Ä': Result
[i
] := 'L';
309 'Æ': Result
[i
] := ';'; //Chr(186);
310 'Ý': Result
[i
] := #39; //Chr(222);
311 'ß': Result
[i
] := 'Z';
312 '×': Result
[i
] := 'X';
313 'Ñ': Result
[i
] := 'C';
314 'Ì': Result
[i
] := 'V';
315 'È': Result
[i
] := 'B';
316 'Ò': Result
[i
] := 'N';
317 'Ü': Result
[i
] := 'M';
318 'Á': Result
[i
] := ','; //Chr(188);
319 'Þ': Result
[i
] := '.'; //Chr(190);
325 function CheckCheat (ct
: TStrings_Locale
; eofs
: Integer=0): Boolean;
330 ls2
:= Translit(CheatRus
[ct
]);
331 if length(ls1
) = 0 then ls1
:= '~';
332 if length(ls2
) = 0 then ls2
:= '~';
334 (Copy(charbuff
, 17-Length(ls1
)-eofs
, Length(ls1
)) = ls1
) or
335 (Translit(Copy(charbuff
, 17-Length(ls1
)-eofs
, Length(ls1
))) = ls1
) or
336 (Copy(charbuff
, 17-Length(ls2
)-eofs
, Length(ls2
)) = ls2
) or
337 (Translit(Copy(charbuff
, 17-Length(ls2
)-eofs
, Length(ls2
))) = ls2
);
339 if ct = I_GAME_CHEAT_JETPACK then
341 e_WriteLog('ls1: ['+ls1+']', MSG_NOTIFY);
342 e_WriteLog('ls2: ['+ls2+']', MSG_NOTIFY);
343 e_WriteLog('bf0: ['+Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))+']', MSG_NOTIFY);
344 e_WriteLog('bf1: ['+Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)))+']', MSG_NOTIFY);
345 e_WriteLog('bf2: ['+Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))+']', MSG_NOTIFY);
346 e_WriteLog('bf3: ['+Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)))+']', MSG_NOTIFY);
363 if (not gGameOn) or (not gCheats) or ((gGameSettings.GameType <> GT_SINGLE) and
364 (gGameSettings.GameMode <> GM_COOP) and (not gDebugMode))
365 or g_Game_IsNet then Exit;
367 if not gGameOn
then exit
;
368 if not conIsCheatsEnabled
then exit
;
370 s
:= 'SOUND_GAME_RADIO';
373 if CheckCheat(I_GAME_CHEAT_GODMODE
) then
375 if gPlayer1
<> nil then gPlayer1
.GodMode
:= not gPlayer1
.GodMode
;
376 if gPlayer2
<> nil then gPlayer2
.GodMode
:= not gPlayer2
.GodMode
;
380 if CheckCheat(I_GAME_CHEAT_WEAPONS
) then
382 if gPlayer1
<> nil then gPlayer1
.AllRulez(False);
383 if gPlayer2
<> nil then gPlayer2
.AllRulez(False);
387 if CheckCheat(I_GAME_CHEAT_HEALTH
) then
389 if gPlayer1
<> nil then gPlayer1
.AllRulez(True);
390 if gPlayer2
<> nil then gPlayer2
.AllRulez(True);
394 if CheckCheat(I_GAME_CHEAT_DEATH
) then
396 if gPlayer1
<> nil then gPlayer1
.Damage(CHEAT_DAMAGE
, 0, 0, 0, HIT_TRAP
);
397 if gPlayer2
<> nil then gPlayer2
.Damage(CHEAT_DAMAGE
, 0, 0, 0, HIT_TRAP
);
398 s
:= 'SOUND_MONSTER_HAHA';
402 if CheckCheat(I_GAME_CHEAT_DOORS
) then
404 g_Triggers_OpenAll();
408 if CheckCheat(I_GAME_CHEAT_NEXTMAP
) then
410 if gTriggers
<> nil then
411 for a
:= 0 to High(gTriggers
) do
412 if gTriggers
[a
].TriggerType
= TRIGGER_EXIT
then
414 gExitByTrigger
:= True;
415 //g_Game_ExitLevel(gTriggers[a].Data.MapName);
416 g_Game_ExitLevel(gTriggers
[a
].tgcMap
);
422 s2
:= Copy(charbuff
, 15, 2);
423 if CheckCheat(I_GAME_CHEAT_CHANGEMAP
, 2) and (s2
[1] >= '0') and (s2
[1] <= '9') and (s2
[2] >= '0') and (s2
[2] <= '9') then
425 if g_Map_Exist(MapsDir
+gGameSettings
.WAD
+':\MAP'+s2
) then
433 if CheckCheat(I_GAME_CHEAT_FLY
) then
439 if CheckCheat(I_GAME_CHEAT_JUMPS
) then
441 VEL_JUMP
:= 30-VEL_JUMP
;
445 if CheckCheat(I_GAME_CHEAT_SPEED
) then
447 MAX_RUNVEL
:= 32-MAX_RUNVEL
;
451 if CheckCheat(I_GAME_CHEAT_SUIT
) then
453 if gPlayer1
<> nil then gPlayer1
.GiveItem(ITEM_SUIT
);
454 if gPlayer2
<> nil then gPlayer2
.GiveItem(ITEM_SUIT
);
458 if CheckCheat(I_GAME_CHEAT_AIR
) then
460 if gPlayer1
<> nil then gPlayer1
.GiveItem(ITEM_OXYGEN
);
461 if gPlayer2
<> nil then gPlayer2
.GiveItem(ITEM_OXYGEN
);
465 if CheckCheat(I_GAME_CHEAT_BERSERK
) then
467 if gPlayer1
<> nil then gPlayer1
.GiveItem(ITEM_MEDKIT_BLACK
);
468 if gPlayer2
<> nil then gPlayer2
.GiveItem(ITEM_MEDKIT_BLACK
);
472 if CheckCheat(I_GAME_CHEAT_JETPACK
) then
474 if gPlayer1
<> nil then gPlayer1
.GiveItem(ITEM_JETPACK
);
475 if gPlayer2
<> nil then gPlayer2
.GiveItem(ITEM_JETPACK
);
479 if CheckCheat(I_GAME_CHEAT_NOCLIP
) then
481 if gPlayer1
<> nil then gPlayer1
.SwitchNoClip
;
482 if gPlayer2
<> nil then gPlayer2
.SwitchNoClip
;
486 if CheckCheat(I_GAME_CHEAT_NOTARGET
) then
488 if gPlayer1
<> nil then gPlayer1
.NoTarget
:= not gPlayer1
.NoTarget
;
489 if gPlayer2
<> nil then gPlayer2
.NoTarget
:= not gPlayer2
.NoTarget
;
493 if CheckCheat(I_GAME_CHEAT_NORELOAD
) then
495 if gPlayer1
<> nil then gPlayer1
.NoReload
:= not gPlayer1
.NoReload
;
496 if gPlayer2
<> nil then gPlayer2
.NoReload
:= not gPlayer2
.NoReload
;
499 if CheckCheat(I_GAME_CHEAT_AIMLINE
) then
501 gAimLine
:= not gAimLine
;
504 if CheckCheat(I_GAME_CHEAT_AUTOMAP
) then
506 gShowMap
:= not gShowMap
;
516 procedure KeyPress (K
: Word);
521 IK_PAUSE
: // <Pause/Break>:
523 if (g_ActiveWindow
= nil) then g_Game_Pause(not gPause
);
526 IK_BACKQUOTE
, VK_CONSOLE
: // <`/~/¨/¸>:
531 IK_ESCAPE
, VK_ESCAPE
: // <Esc>:
535 g_Console_Chat_Switch();
543 else if (g_ActiveWindow
<> nil) then
545 Msg
.Msg
:= WM_KEYDOWN
;
546 Msg
.WParam
:= IK_ESCAPE
;
547 g_ActiveWindow
.OnMessage(Msg
);
548 if (not g_Game_IsNet
) and (g_ActiveWindow
= nil) then g_Game_Pause(false); //Fn loves to do this
550 else if (gState
<> STATE_FOLD
) then
552 if gGameOn
or (gState
= STATE_INTERSINGLE
) or (gState
= STATE_INTERCUSTOM
) then
554 g_Game_InGameMenu(True);
556 else if (gExit
= 0) and (gState
<> STATE_SLIST
) then
558 if (gState
<> STATE_MENU
) then
560 if (NetMode
<> NET_NONE
) then
562 g_Game_StopAllSounds(True);
564 gState
:= STATE_MENU
;
568 g_GUI_ShowWindow('MainMenu');
569 g_Sound_PlayEx('MENU_OPEN');
574 IK_F2
, IK_F3
, IK_F4
, IK_F5
, IK_F6
, IK_F7
, IK_F10
:
575 begin // <F2> .. <F6> � <F12>
576 if gGameOn
and (not gConsoleShow
) and (not gChatShow
) then
578 while (g_ActiveWindow
<> nil) do g_GUI_HideWindow(False);
579 if (not g_Game_IsNet
) then g_Game_Pause(True);
581 IK_F2
: g_Menu_Show_SaveMenu();
582 IK_F3
: g_Menu_Show_LoadMenu();
583 IK_F4
: g_Menu_Show_GameSetGame();
584 IK_F5
: g_Menu_Show_OptionsVideo();
585 IK_F6
: g_Menu_Show_OptionsSound();
586 IK_F7
: g_Menu_Show_EndGameMenu();
587 IK_F10
: g_Menu_Show_QuitGameMenu();
594 gJustChatted
:= False;
595 if gConsoleShow
or gChatShow
then
597 g_Console_Control(K
);
599 else if (g_ActiveWindow
<> nil) then
601 Msg
.Msg
:= WM_KEYDOWN
;
603 g_ActiveWindow
.OnMessage(Msg
);
605 else if (gState
= STATE_MENU
) then
607 g_GUI_ShowWindow('MainMenu');
608 g_Sound_PlayEx('MENU_OPEN');
615 procedure CharPress (C
: AnsiChar);
620 if (not gChatShow
) and ((C
= '`') or (C
= '~') or (C
= '¸') or (C
= '¨')) then Exit
;
622 if gConsoleShow
or gChatShow
then
626 else if (g_ActiveWindow
<> nil) then
629 Msg
.WParam
:= Ord(C
);
630 g_ActiveWindow
.OnMessage(Msg
);
634 for a
:= 0 to 14 do charbuff
[a
] := charbuff
[a
+1];
635 charbuff
[15] := upcase1251(C
);