DEADSOFTWARE

added libsocket and updated watt32, but network still not work
[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 {$INCLUDE ../nogl/noGLuses.inc}
41 {$IFDEF USE_WATT32}
42 Watt32,
43 {$ENDIF}
44 {$IFDEF USE_LIBSOCKET}
45 Socket,
46 {$ENDIF}
47 {$IFDEF ENABLE_HOLMES}
48 g_holmes, fui_wadread, fui_style, fui_gfx_gl,
49 {$ENDIF}
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,
56 xparser;
59 var
60 charbuff: packed array [0..15] of AnsiChar;
62 procedure Main();
63 var
64 sdlflags: LongWord;
65 {$IF not DEFINED(HEADLESS) and DEFINED(ENABLE_HOLMES)}
66 flexloaded: Boolean;
67 {$ENDIF}
68 begin
69 e_InitWritelnDriver();
71 GetDir(0, GameDir);
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);
79 e_WriteLog(
80 'Doom 2D: Forever version ' + GAME_VERSION +
81 ' proto ' + IntToStr(NET_PROTOCOL_VER),
82 TMsgType.Notify
83 );
84 e_WriteLog(
85 'Build date: ' + GAME_BUILDDATE + ' ' + GAME_BUILDTIME,
86 TMsgType.Notify
87 );
89 {$IFDEF USE_WATT32}
90 sdlflags := sock_init;
91 {$IFDEF USE_SDL2ALLEGRO}
92 hires_timer(0);
93 init_userSuppliedTimerTick;
94 {$ENDIF}
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),
103 TMsgType.Notify
104 );
105 {$ENDIF}
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);
110 {$ENDIF}
112 {$IFDEF HEADLESS}
113 conbufDumpToStdOut := true;
114 {$ENDIF}
115 e_WriteToStdOut := False; //{$IFDEF HEADLESS}True;{$ELSE}False;{$ENDIF}
117 {$IFDEF HEADLESS}
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');
122 {$ELSE}
123 sdlflags := SDL_INIT_TIMER or $00004000;
124 {$ENDIF}
125 {$ELSE}
126 {$IFDEF USE_SDLMIXER}
127 {*sdlflags := SDL_INIT_EVERYTHING;*}
128 sdlflags := SDL_INIT_JOYSTICK or SDL_INIT_TIMER or SDL_INIT_VIDEO;
129 {$ELSE}
130 sdlflags := SDL_INIT_JOYSTICK or SDL_INIT_TIMER or SDL_INIT_VIDEO;
131 {$ENDIF}
132 {$ENDIF}
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);
149 {$IFNDEF HEADLESS}
150 {$IFNDEF ANDROID}
151 SDL_StartTextInput();
152 {$ENDIF}
153 {$ENDIF}
155 {$IF not DEFINED(HEADLESS) and DEFINED(ENABLE_HOLMES)}
156 flexloaded := true;
157 if not fuiAddWad('flexui.wad') then
158 begin
159 if not fuiAddWad('./data/flexui.wad') then fuiAddWad('./flexui.wad');
160 end;
161 try
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
168 begin
169 writeln('ERROR loading FlexUI fonts');
170 flexloaded := false;
171 //raise;
172 end;
173 else
174 begin
175 flexloaded := false;
176 //raise;
177 end;
178 end;
179 if (flexloaded) then
180 begin
181 try
182 e_LogWriteln('FlexUI: loading stylesheet...');
183 uiLoadStyles('flexui/widgets.wgs');
184 except on e: TParserException do
185 begin
186 writeln('ERROR at (', e.tokLine, ',', e.tokCol, '): ', e.message);
187 //raise;
188 flexloaded := false;
189 end;
190 else
191 begin
192 //raise;
193 flexloaded := false;
194 end;
195 end;
196 end;
197 g_holmes_imfunctional := not flexloaded;
198 {$ENDIF}
200 e_WriteLog('Entering SDLMain', TMsgType.Notify);
202 {$WARNINGS OFF}
203 SDLMain();
204 {$WARNINGS ON}
206 {$IFNDEF HEADLESS}
207 SDL_StopTextInput();
208 {$ENDIF}
210 e_WriteLog('Releasing SDL', TMsgType.Notify);
211 SDL_Quit();
212 end;
214 procedure Init();
215 var
216 NoSound: Boolean;
217 begin
218 Randomize;
220 {$IFDEF HEADLESS}
221 {$IFDEF USE_SDLMIXER}
222 NoSound := False; // hope env has set SDL_AUDIODRIVER to dummy
223 {$ELSE}
224 NoSound := True; // FMOD backend will sort it out
225 {$ENDIF}
226 {$ELSE}
227 NoSound := False;
228 {$ENDIF}
230 e_WriteLog('Init Input', TMsgType.Notify);
231 e_InitInput();
232 g_Touch_Init;
234 if (e_JoysticksAvailable > 0) then
235 e_WriteLog('Input: Joysticks available.', TMsgType.Notify)
236 else
237 e_WriteLog('Input: No Joysticks.', TMsgType.Notify);
239 if (not gNoSound) then
240 begin
241 e_WriteLog('Initializing sound system', TMsgType.Notify);
242 e_InitSoundSystem(NoSound);
243 end;
245 e_WriteLog('Init game', TMsgType.Notify);
246 g_Game_Init();
248 FillChar(charbuff, sizeof(charbuff), ' ');
249 end;
252 procedure Release();
253 begin
254 e_WriteLog('Releasing engine', TMsgType.Notify);
255 e_ReleaseEngine();
257 e_WriteLog('Releasing Input', TMsgType.Notify);
258 e_ReleaseInput();
260 if not gNoSound then
261 begin
262 e_WriteLog('Releasing FMOD', TMsgType.Notify);
263 e_ReleaseSoundSystem();
264 end;
265 end;
268 procedure Update ();
269 begin
270 g_Game_Update();
271 end;
274 procedure Draw ();
275 begin
276 g_Game_Draw();
277 end;
280 function Translit (const S: AnsiString): AnsiString;
281 var
282 i: Integer;
283 begin
284 Result := S;
285 for i := 1 to Length(Result) do
286 begin
287 case Result[i] of
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);
320 end;
321 end;
322 end;
325 function CheckCheat (ct: TStrings_Locale; eofs: Integer=0): Boolean;
326 var
327 ls1, ls2: string;
328 begin
329 ls1 := CheatEng[ct];
330 ls2 := Translit(CheatRus[ct]);
331 if length(ls1) = 0 then ls1 := '~';
332 if length(ls2) = 0 then ls2 := '~';
333 result :=
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
340 begin
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);
347 end;
349 end;
352 procedure Cheat ();
353 const
354 CHEAT_DAMAGE = 500;
355 label
356 Cheated;
357 var
358 s, s2: string;
359 c: ShortString;
360 a: Integer;
361 begin
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';
372 //
373 if CheckCheat(I_GAME_CHEAT_GODMODE) then
374 begin
375 if gPlayer1 <> nil then gPlayer1.GodMode := not gPlayer1.GodMode;
376 if gPlayer2 <> nil then gPlayer2.GodMode := not gPlayer2.GodMode;
377 goto Cheated;
378 end;
379 // RAMBO
380 if CheckCheat(I_GAME_CHEAT_WEAPONS) then
381 begin
382 if gPlayer1 <> nil then gPlayer1.AllRulez(False);
383 if gPlayer2 <> nil then gPlayer2.AllRulez(False);
384 goto Cheated;
385 end;
386 // TANK
387 if CheckCheat(I_GAME_CHEAT_HEALTH) then
388 begin
389 if gPlayer1 <> nil then gPlayer1.AllRulez(True);
390 if gPlayer2 <> nil then gPlayer2.AllRulez(True);
391 goto Cheated;
392 end;
393 // IDDQD
394 if CheckCheat(I_GAME_CHEAT_DEATH) then
395 begin
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';
399 goto Cheated;
400 end;
401 //
402 if CheckCheat(I_GAME_CHEAT_DOORS) then
403 begin
404 g_Triggers_OpenAll();
405 goto Cheated;
406 end;
407 // GOODBYE
408 if CheckCheat(I_GAME_CHEAT_NEXTMAP) then
409 begin
410 if gTriggers <> nil then
411 for a := 0 to High(gTriggers) do
412 if gTriggers[a].TriggerType = TRIGGER_EXIT then
413 begin
414 gExitByTrigger := True;
415 //g_Game_ExitLevel(gTriggers[a].Data.MapName);
416 g_Game_ExitLevel(gTriggers[a].tgcMap);
417 Break;
418 end;
419 goto Cheated;
420 end;
421 //
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
424 begin
425 if g_Map_Exist(MapsDir+gGameSettings.WAD+':\MAP'+s2) then
426 begin
427 c := 'MAP'+s2;
428 g_Game_ExitLevel(c);
429 end;
430 goto Cheated;
431 end;
432 //
433 if CheckCheat(I_GAME_CHEAT_FLY) then
434 begin
435 gFly := not gFly;
436 goto Cheated;
437 end;
438 // BULLFROG
439 if CheckCheat(I_GAME_CHEAT_JUMPS) then
440 begin
441 VEL_JUMP := 30-VEL_JUMP;
442 goto Cheated;
443 end;
444 // FORMULA1
445 if CheckCheat(I_GAME_CHEAT_SPEED) then
446 begin
447 MAX_RUNVEL := 32-MAX_RUNVEL;
448 goto Cheated;
449 end;
450 // CONDOM
451 if CheckCheat(I_GAME_CHEAT_SUIT) then
452 begin
453 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_SUIT);
454 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_SUIT);
455 goto Cheated;
456 end;
457 //
458 if CheckCheat(I_GAME_CHEAT_AIR) then
459 begin
460 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_OXYGEN);
461 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_OXYGEN);
462 goto Cheated;
463 end;
464 // PURELOVE
465 if CheckCheat(I_GAME_CHEAT_BERSERK) then
466 begin
467 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_MEDKIT_BLACK);
468 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_MEDKIT_BLACK);
469 goto Cheated;
470 end;
471 //
472 if CheckCheat(I_GAME_CHEAT_JETPACK) then
473 begin
474 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_JETPACK);
475 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_JETPACK);
476 goto Cheated;
477 end;
478 // CASPER
479 if CheckCheat(I_GAME_CHEAT_NOCLIP) then
480 begin
481 if gPlayer1 <> nil then gPlayer1.SwitchNoClip;
482 if gPlayer2 <> nil then gPlayer2.SwitchNoClip;
483 goto Cheated;
484 end;
485 //
486 if CheckCheat(I_GAME_CHEAT_NOTARGET) then
487 begin
488 if gPlayer1 <> nil then gPlayer1.NoTarget := not gPlayer1.NoTarget;
489 if gPlayer2 <> nil then gPlayer2.NoTarget := not gPlayer2.NoTarget;
490 goto Cheated;
491 end;
492 // INFERNO
493 if CheckCheat(I_GAME_CHEAT_NORELOAD) then
494 begin
495 if gPlayer1 <> nil then gPlayer1.NoReload := not gPlayer1.NoReload;
496 if gPlayer2 <> nil then gPlayer2.NoReload := not gPlayer2.NoReload;
497 goto Cheated;
498 end;
499 if CheckCheat(I_GAME_CHEAT_AIMLINE) then
500 begin
501 gAimLine := not gAimLine;
502 goto Cheated;
503 end;
504 if CheckCheat(I_GAME_CHEAT_AUTOMAP) then
505 begin
506 gShowMap := not gShowMap;
507 goto Cheated;
508 end;
509 Exit;
511 Cheated:
512 g_Sound_PlayEx(s);
513 end;
516 procedure KeyPress (K: Word);
517 var
518 Msg: g_gui.TMessage;
519 begin
520 case K of
521 IK_PAUSE: // <Pause/Break>:
522 begin
523 if (g_ActiveWindow = nil) then g_Game_Pause(not gPause);
524 end;
526 IK_BACKQUOTE, VK_CONSOLE: // <`/~/¨/¸>:
527 begin
528 g_Console_Switch();
529 end;
531 IK_ESCAPE, VK_ESCAPE: // <Esc>:
532 begin
533 if gChatShow then
534 begin
535 g_Console_Chat_Switch();
536 Exit;
537 end;
539 if gConsoleShow then
540 begin
541 g_Console_Switch();
542 end
543 else if (g_ActiveWindow <> nil) then
544 begin
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
549 end
550 else if (gState <> STATE_FOLD) then
551 begin
552 if gGameOn or (gState = STATE_INTERSINGLE) or (gState = STATE_INTERCUSTOM) then
553 begin
554 g_Game_InGameMenu(True);
555 end
556 else if (gExit = 0) and (gState <> STATE_SLIST) then
557 begin
558 if (gState <> STATE_MENU) then
559 begin
560 if (NetMode <> NET_NONE) then
561 begin
562 g_Game_StopAllSounds(True);
563 g_Game_Free;
564 gState := STATE_MENU;
565 Exit;
566 end;
567 end;
568 g_GUI_ShowWindow('MainMenu');
569 g_Sound_PlayEx('MENU_OPEN');
570 end;
571 end;
572 end;
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
577 begin
578 while (g_ActiveWindow <> nil) do g_GUI_HideWindow(False);
579 if (not g_Game_IsNet) then g_Game_Pause(True);
580 case K of
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();
588 end;
589 end;
590 end;
592 else
593 begin
594 gJustChatted := False;
595 if gConsoleShow or gChatShow then
596 begin
597 g_Console_Control(K);
598 end
599 else if (g_ActiveWindow <> nil) then
600 begin
601 Msg.Msg := WM_KEYDOWN;
602 Msg.WParam := K;
603 g_ActiveWindow.OnMessage(Msg);
604 end
605 else if (gState = STATE_MENU) then
606 begin
607 g_GUI_ShowWindow('MainMenu');
608 g_Sound_PlayEx('MENU_OPEN');
609 end;
610 end;
611 end;
612 end;
615 procedure CharPress (C: AnsiChar);
616 var
617 Msg: g_gui.TMessage;
618 a: Integer;
619 begin
620 if (not gChatShow) and ((C = '`') or (C = '~') or (C = '¸') or (C = '¨')) then Exit;
622 if gConsoleShow or gChatShow then
623 begin
624 g_Console_Char(C);
625 end
626 else if (g_ActiveWindow <> nil) then
627 begin
628 Msg.Msg := WM_CHAR;
629 Msg.WParam := Ord(C);
630 g_ActiveWindow.OnMessage(Msg);
631 end
632 else
633 begin
634 for a := 0 to 14 do charbuff[a] := charbuff[a+1];
635 charbuff[15] := upcase1251(C);
636 Cheat();
637 end;
638 end;
641 end.