DEADSOFTWARE

write version and built time to log
[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, either version 3 of the License, or
6 * (at your option) any later version.
7 *
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.
12 *
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/>.
15 *)
16 {$INCLUDE ../shared/a_modes.inc}
17 unit g_main;
19 interface
21 procedure Main ();
22 procedure Init ();
23 procedure Release ();
24 procedure Update ();
25 procedure Draw ();
26 procedure KeyPress (K: Word);
27 procedure CharPress (C: AnsiChar);
29 var
30 GameDir: string;
31 DataDir: string;
32 MapsDir: string;
33 ModelsDir: string;
34 GameWAD: string;
37 implementation
39 uses
40 SDL2, GL, GLExt, wadreader, e_log, g_window,
41 e_graphics, e_input, g_game, g_console, g_gui,
42 e_sound, g_options, g_sound, g_player, g_basic,
43 g_weapons, SysUtils, g_triggers, MAPDEF, g_map,
44 g_menu, g_language, g_net, g_holmes,
45 utils, conbuf, envvars, fui_wadread, fui_style,
46 fui_gfx_gl, xparser;
49 var
50 charbuff: packed array [0..15] of AnsiChar;
52 procedure Main();
53 var
54 sdlflags: LongWord;
55 {$IFNDEF HEADLESS}
56 flexloaded: Boolean;
57 {$ENDIF}
58 begin
59 e_InitWritelnDriver();
61 GetDir(0, GameDir);
62 MapsDir := GameDir + '/maps/';
63 DataDir := GameDir + '/data/';
64 ModelsDir := DataDir + 'models/';
65 GameWAD := DataDir + 'Game.wad';
67 e_InitLog(GameDir + '/' + LOG_FILENAME, TWriteMode.WM_NEWFILE);
69 e_WriteLog(
70 'Doom 2D: Forever version ' + GAME_VERSION +
71 ' proto ' + IntToStr(NET_PROTOCOL_VER),
72 TMsgType.Notify
73 );
74 e_WriteLog(
75 'Build date: ' + GAME_BUILDDATE + ' ' + GAME_BUILDTIME,
76 TMsgType.Notify
77 );
79 e_WriteLog('Read config file', TMsgType.Notify);
80 g_Options_Read(GameDir + '/' + CONFIG_FILENAME);
82 {$IFDEF HEADLESS}
83 conbufDumpToStdOut := true;
84 {$ENDIF}
85 e_WriteToStdOut := False; //{$IFDEF HEADLESS}True;{$ELSE}False;{$ENDIF}
87 //GetSystemDefaultLCID()
89 //e_WriteLog('Read language file', MSG_NOTIFY);
90 //g_Language_Load(DataDir + gLanguage + '.txt');
91 e_WriteLog(gLanguage, TMsgType.Notify);
92 g_Language_Set(gLanguage);
94 {$IFDEF HEADLESS}
95 {$IFDEF USE_SDLMIXER}
96 sdlflags := SDL_INIT_TIMER or SDL_INIT_AUDIO or $00004000;
97 // HACK: shit this into env and hope for the best
98 SetEnvVar('SDL_AUDIODRIVER', 'dummy');
99 {$ELSE}
100 sdlflags := SDL_INIT_TIMER or $00004000;
101 {$ENDIF}
102 {$ELSE}
103 {$IFDEF USE_SDLMIXER}
104 {*sdlflags := SDL_INIT_EVERYTHING;*}
105 sdlflags := SDL_INIT_JOYSTICK or SDL_INIT_TIMER or SDL_INIT_VIDEO;
106 {$ELSE}
107 sdlflags := SDL_INIT_JOYSTICK or SDL_INIT_TIMER or SDL_INIT_VIDEO;
108 {$ENDIF}
109 {$ENDIF}
110 if SDL_Init(sdlflags) < 0 then
111 raise Exception.Create('SDL: Init failed: ' + SDL_GetError());
113 {$IFNDEF HEADLESS}
114 SDL_StartTextInput();
115 {$ENDIF}
117 {$IFNDEF HEADLESS}
118 flexloaded := true;
119 if not fuiAddWad('flexui.wad') then
120 begin
121 if not fuiAddWad('./data/flexui.wad') then fuiAddWad('./flexui.wad');
122 end;
123 try
124 fuiGfxLoadFont('win8', 'flexui/fonts/win8.fuifont');
125 fuiGfxLoadFont('win14', 'flexui/fonts/win14.fuifont');
126 fuiGfxLoadFont('win16', 'flexui/fonts/win16.fuifont');
127 fuiGfxLoadFont('dos8', 'flexui/fonts/dos8.fuifont');
128 fuiGfxLoadFont('msx6', 'flexui/fonts/msx6.fuifont');
129 except on e: Exception do
130 begin
131 writeln('ERROR loading FlexUI fonts');
132 flexloaded := false;
133 //raise;
134 end;
135 else
136 begin
137 flexloaded := false;
138 //raise;
139 end;
140 end;
141 if (flexloaded) then
142 begin
143 try
144 e_LogWriteln('FlexUI: loading stylesheet...');
145 uiLoadStyles('flexui/widgets.wgs');
146 except on e: TParserException do
147 begin
148 writeln('ERROR at (', e.tokLine, ',', e.tokCol, '): ', e.message);
149 //raise;
150 flexloaded := false;
151 end;
152 else
153 begin
154 //raise;
155 flexloaded := false;
156 end;
157 end;
158 end;
159 g_holmes_imfunctional := not flexloaded;
160 {$ENDIF}
162 e_WriteLog('Entering SDLMain', TMsgType.Notify);
164 {$WARNINGS OFF}
165 SDLMain();
166 {$WARNINGS ON}
168 {$IFNDEF HEADLESS}
169 SDL_StopTextInput();
170 {$ENDIF}
172 e_WriteLog('Releasing SDL', TMsgType.Notify);
173 SDL_Quit();
174 end;
176 procedure Init();
177 var
178 NoSound: Boolean;
179 begin
180 Randomize;
182 {$IFDEF HEADLESS}
183 {$IFDEF USE_SDLMIXER}
184 NoSound := False; // hope env has set SDL_AUDIODRIVER to dummy
185 {$ELSE}
186 NoSound := True; // FMOD backend will sort it out
187 {$ENDIF}
188 {$ELSE}
189 NoSound := False;
190 {$ENDIF}
192 e_WriteLog('Init Input', TMsgType.Notify);
193 e_InitInput();
195 if (e_JoysticksAvailable > 0) then
196 e_WriteLog('Input: Joysticks available.', TMsgType.Notify)
197 else
198 e_WriteLog('Input: No Joysticks.', TMsgType.Notify);
200 if (not gNoSound) then
201 begin
202 e_WriteLog('Initializing sound system', TMsgType.Notify);
203 e_InitSoundSystem(NoSound);
204 end;
206 e_WriteLog('Init game', TMsgType.Notify);
207 g_Game_Init();
209 FillChar(charbuff, sizeof(charbuff), ' ');
210 end;
213 procedure Release();
214 begin
215 e_WriteLog('Releasing engine', TMsgType.Notify);
216 e_ReleaseEngine();
218 e_WriteLog('Releasing Input', TMsgType.Notify);
219 e_ReleaseInput();
221 if not gNoSound then
222 begin
223 e_WriteLog('Releasing FMOD', TMsgType.Notify);
224 e_ReleaseSoundSystem();
225 end;
226 end;
229 procedure Update ();
230 begin
231 g_Game_Update();
232 end;
235 procedure Draw ();
236 begin
237 g_Game_Draw();
238 end;
241 function Translit (const S: AnsiString): AnsiString;
242 var
243 i: Integer;
244 begin
245 Result := S;
246 for i := 1 to Length(Result) do
247 begin
248 case Result[i] of
249 'É': Result[i] := 'Q';
250 'Ö': Result[i] := 'W';
251 'Ó': Result[i] := 'E';
252 'Ê': Result[i] := 'R';
253 'Å': Result[i] := 'T';
254 'Í': Result[i] := 'Y';
255 'Ã': Result[i] := 'U';
256 'Ø': Result[i] := 'I';
257 'Ù': Result[i] := 'O';
258 'Ç': Result[i] := 'P';
259 'Õ': Result[i] := '['; //Chr(219);
260 'Ú': Result[i] := ']'; //Chr(221);
261 'Ô': Result[i] := 'A';
262 'Û': Result[i] := 'S';
263 'Â': Result[i] := 'D';
264 'À': Result[i] := 'F';
265 'Ï': Result[i] := 'G';
266 'Ð': Result[i] := 'H';
267 'Î': Result[i] := 'J';
268 'Ë': Result[i] := 'K';
269 'Ä': Result[i] := 'L';
270 'Æ': Result[i] := ';'; //Chr(186);
271 'Ý': Result[i] := #39; //Chr(222);
272 'ß': Result[i] := 'Z';
273 '×': Result[i] := 'X';
274 'Ñ': Result[i] := 'C';
275 'Ì': Result[i] := 'V';
276 'È': Result[i] := 'B';
277 'Ò': Result[i] := 'N';
278 'Ü': Result[i] := 'M';
279 'Á': Result[i] := ','; //Chr(188);
280 'Þ': Result[i] := '.'; //Chr(190);
281 end;
282 end;
283 end;
286 function CheckCheat (ct: TStrings_Locale; eofs: Integer=0): Boolean;
287 var
288 ls1, ls2: string;
289 begin
290 ls1 := CheatEng[ct];
291 ls2 := Translit(CheatRus[ct]);
292 if length(ls1) = 0 then ls1 := '~';
293 if length(ls2) = 0 then ls2 := '~';
294 result :=
295 (Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)) = ls1) or
296 (Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))) = ls1) or
297 (Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)) = ls2) or
298 (Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))) = ls2);
300 if ct = I_GAME_CHEAT_JETPACK then
301 begin
302 e_WriteLog('ls1: ['+ls1+']', MSG_NOTIFY);
303 e_WriteLog('ls2: ['+ls2+']', MSG_NOTIFY);
304 e_WriteLog('bf0: ['+Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))+']', MSG_NOTIFY);
305 e_WriteLog('bf1: ['+Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)))+']', MSG_NOTIFY);
306 e_WriteLog('bf2: ['+Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))+']', MSG_NOTIFY);
307 e_WriteLog('bf3: ['+Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)))+']', MSG_NOTIFY);
308 end;
310 end;
313 procedure Cheat ();
314 const
315 CHEAT_DAMAGE = 500;
316 label
317 Cheated;
318 var
319 s, s2: string;
320 c: ShortString;
321 a: Integer;
322 begin
324 if (not gGameOn) or (not gCheats) or ((gGameSettings.GameType <> GT_SINGLE) and
325 (gGameSettings.GameMode <> GM_COOP) and (not gDebugMode))
326 or g_Game_IsNet then Exit;
328 if not gGameOn then exit;
329 if not conIsCheatsEnabled then exit;
331 s := 'SOUND_GAME_RADIO';
333 //
334 if CheckCheat(I_GAME_CHEAT_GODMODE) then
335 begin
336 if gPlayer1 <> nil then gPlayer1.GodMode := not gPlayer1.GodMode;
337 if gPlayer2 <> nil then gPlayer2.GodMode := not gPlayer2.GodMode;
338 goto Cheated;
339 end;
340 // RAMBO
341 if CheckCheat(I_GAME_CHEAT_WEAPONS) then
342 begin
343 if gPlayer1 <> nil then gPlayer1.AllRulez(False);
344 if gPlayer2 <> nil then gPlayer2.AllRulez(False);
345 goto Cheated;
346 end;
347 // TANK
348 if CheckCheat(I_GAME_CHEAT_HEALTH) then
349 begin
350 if gPlayer1 <> nil then gPlayer1.AllRulez(True);
351 if gPlayer2 <> nil then gPlayer2.AllRulez(True);
352 goto Cheated;
353 end;
354 // IDDQD
355 if CheckCheat(I_GAME_CHEAT_DEATH) then
356 begin
357 if gPlayer1 <> nil then gPlayer1.Damage(CHEAT_DAMAGE, 0, 0, 0, HIT_TRAP);
358 if gPlayer2 <> nil then gPlayer2.Damage(CHEAT_DAMAGE, 0, 0, 0, HIT_TRAP);
359 s := 'SOUND_MONSTER_HAHA';
360 goto Cheated;
361 end;
362 //
363 if CheckCheat(I_GAME_CHEAT_DOORS) then
364 begin
365 g_Triggers_OpenAll();
366 goto Cheated;
367 end;
368 // GOODBYE
369 if CheckCheat(I_GAME_CHEAT_NEXTMAP) then
370 begin
371 if gTriggers <> nil then
372 for a := 0 to High(gTriggers) do
373 if gTriggers[a].TriggerType = TRIGGER_EXIT then
374 begin
375 gExitByTrigger := True;
376 //g_Game_ExitLevel(gTriggers[a].Data.MapName);
377 g_Game_ExitLevel(gTriggers[a].tgcMap);
378 Break;
379 end;
380 goto Cheated;
381 end;
382 //
383 s2 := Copy(charbuff, 15, 2);
384 if CheckCheat(I_GAME_CHEAT_CHANGEMAP, 2) and (s2[1] >= '0') and (s2[1] <= '9') and (s2[2] >= '0') and (s2[2] <= '9') then
385 begin
386 if g_Map_Exist(MapsDir+gGameSettings.WAD+':\MAP'+s2) then
387 begin
388 c := 'MAP'+s2;
389 g_Game_ExitLevel(c);
390 end;
391 goto Cheated;
392 end;
393 //
394 if CheckCheat(I_GAME_CHEAT_FLY) then
395 begin
396 gFly := not gFly;
397 goto Cheated;
398 end;
399 // BULLFROG
400 if CheckCheat(I_GAME_CHEAT_JUMPS) then
401 begin
402 VEL_JUMP := 30-VEL_JUMP;
403 goto Cheated;
404 end;
405 // FORMULA1
406 if CheckCheat(I_GAME_CHEAT_SPEED) then
407 begin
408 MAX_RUNVEL := 32-MAX_RUNVEL;
409 goto Cheated;
410 end;
411 // CONDOM
412 if CheckCheat(I_GAME_CHEAT_SUIT) then
413 begin
414 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_SUIT);
415 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_SUIT);
416 goto Cheated;
417 end;
418 //
419 if CheckCheat(I_GAME_CHEAT_AIR) then
420 begin
421 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_OXYGEN);
422 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_OXYGEN);
423 goto Cheated;
424 end;
425 // PURELOVE
426 if CheckCheat(I_GAME_CHEAT_BERSERK) then
427 begin
428 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_MEDKIT_BLACK);
429 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_MEDKIT_BLACK);
430 goto Cheated;
431 end;
432 //
433 if CheckCheat(I_GAME_CHEAT_JETPACK) then
434 begin
435 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_JETPACK);
436 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_JETPACK);
437 goto Cheated;
438 end;
439 // CASPER
440 if CheckCheat(I_GAME_CHEAT_NOCLIP) then
441 begin
442 if gPlayer1 <> nil then gPlayer1.SwitchNoClip;
443 if gPlayer2 <> nil then gPlayer2.SwitchNoClip;
444 goto Cheated;
445 end;
446 //
447 if CheckCheat(I_GAME_CHEAT_NOTARGET) then
448 begin
449 if gPlayer1 <> nil then gPlayer1.NoTarget := not gPlayer1.NoTarget;
450 if gPlayer2 <> nil then gPlayer2.NoTarget := not gPlayer2.NoTarget;
451 goto Cheated;
452 end;
453 // INFERNO
454 if CheckCheat(I_GAME_CHEAT_NORELOAD) then
455 begin
456 if gPlayer1 <> nil then gPlayer1.NoReload := not gPlayer1.NoReload;
457 if gPlayer2 <> nil then gPlayer2.NoReload := not gPlayer2.NoReload;
458 goto Cheated;
459 end;
460 if CheckCheat(I_GAME_CHEAT_AIMLINE) then
461 begin
462 gAimLine := not gAimLine;
463 goto Cheated;
464 end;
465 if CheckCheat(I_GAME_CHEAT_AUTOMAP) then
466 begin
467 gShowMap := not gShowMap;
468 goto Cheated;
469 end;
470 Exit;
472 Cheated:
473 g_Sound_PlayEx(s);
474 end;
477 procedure KeyPress (K: Word);
478 var
479 Msg: g_gui.TMessage;
480 begin
481 case K of
482 IK_PAUSE: // <Pause/Break>:
483 begin
484 if (g_ActiveWindow = nil) then g_Game_Pause(not gPause);
485 end;
487 IK_BACKQUOTE: // <`/~/¨/¸>:
488 begin
489 g_Console_Switch();
490 end;
492 IK_ESCAPE: // <Esc>:
493 begin
494 if gChatShow then
495 begin
496 g_Console_Chat_Switch();
497 Exit;
498 end;
500 if gConsoleShow then
501 begin
502 g_Console_Switch();
503 end
504 else if (g_ActiveWindow <> nil) then
505 begin
506 Msg.Msg := WM_KEYDOWN;
507 Msg.WParam := IK_ESCAPE;
508 g_ActiveWindow.OnMessage(Msg);
509 if (not g_Game_IsNet) and (g_ActiveWindow = nil) then g_Game_Pause(false); //Fn loves to do this
510 end
511 else if (gState <> STATE_FOLD) then
512 begin
513 if gGameOn or (gState = STATE_INTERSINGLE) or (gState = STATE_INTERCUSTOM) then
514 begin
515 g_Game_InGameMenu(True);
516 end
517 else if (gExit = 0) and (gState <> STATE_SLIST) then
518 begin
519 if (gState <> STATE_MENU) then
520 begin
521 if (NetMode <> NET_NONE) then
522 begin
523 g_Game_StopAllSounds(True);
524 g_Game_Free;
525 gState := STATE_MENU;
526 Exit;
527 end;
528 end;
529 g_GUI_ShowWindow('MainMenu');
530 g_Sound_PlayEx('MENU_OPEN');
531 end;
532 end;
533 end;
535 IK_F2, IK_F3, IK_F4, IK_F5, IK_F6, IK_F7, IK_F10:
536 begin // <F2> .. <F6> � <F12>
537 if gGameOn and (not gConsoleShow) and (not gChatShow) then
538 begin
539 while (g_ActiveWindow <> nil) do g_GUI_HideWindow(False);
540 if (not g_Game_IsNet) then g_Game_Pause(True);
541 case K of
542 IK_F2: g_Menu_Show_SaveMenu();
543 IK_F3: g_Menu_Show_LoadMenu();
544 IK_F4: g_Menu_Show_GameSetGame();
545 IK_F5: g_Menu_Show_OptionsVideo();
546 IK_F6: g_Menu_Show_OptionsSound();
547 IK_F7: g_Menu_Show_EndGameMenu();
548 IK_F10: g_Menu_Show_QuitGameMenu();
549 end;
550 end;
551 end;
553 else
554 begin
555 gJustChatted := False;
556 if gConsoleShow or gChatShow then
557 begin
558 g_Console_Control(K);
559 end
560 else if (g_ActiveWindow <> nil) then
561 begin
562 Msg.Msg := WM_KEYDOWN;
563 Msg.WParam := K;
564 g_ActiveWindow.OnMessage(Msg);
565 end
566 else if (gState = STATE_MENU) then
567 begin
568 g_GUI_ShowWindow('MainMenu');
569 g_Sound_PlayEx('MENU_OPEN');
570 end;
571 end;
572 end;
573 end;
576 procedure CharPress (C: AnsiChar);
577 var
578 Msg: g_gui.TMessage;
579 a: Integer;
580 begin
581 if (not gChatShow) and ((C = '`') or (C = '~') or (C = '¸') or (C = '¨')) then Exit;
583 if gConsoleShow or gChatShow then
584 begin
585 g_Console_Char(C);
586 end
587 else if (g_ActiveWindow <> nil) then
588 begin
589 Msg.Msg := WM_CHAR;
590 Msg.WParam := Ord(C);
591 g_ActiveWindow.OnMessage(Msg);
592 end
593 else
594 begin
595 for a := 0 to 14 do charbuff[a] := charbuff[a+1];
596 charbuff[15] := upcase1251(C);
597 Cheat();
598 end;
599 end;
602 end.