DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob


8142dd83c30f7c1fd14b4a28fe650aec0769415a
[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;
17
18 interface
19
20 uses Utils;
21
22 procedure Main ();
23 procedure Init ();
24 procedure Release ();
25 procedure Update ();
26 procedure Draw ();
27 procedure KeyPress (K: Word);
28 procedure CharPress (C: AnsiChar);
29
30 var
31 {--- Read-only dirs ---}
32 GameWAD: string;
33 DataDirs: SSArray;
34 ModelDirs: SSArray;
35 MegawadDirs: SSArray;
36 MapDirs: SSArray;
37 WadDirs: SSArray;
38 AllMapDirs: SSArray; // Maps + Megawads
39
40 {--- Read-Write dirs ---}
41 LogFileName: string;
42 LogDirs: SSArray;
43 SaveDirs: SSArray;
44 CacheDirs: SSArray;
45 ConfigDirs: SSArray;
46 ScreenshotDirs: SSArray;
47 MapDownloadDirs: SSArray;
48 WadDownloadDirs: SSArray;
49
50 implementation
51
52 uses
53 {$INCLUDE ../nogl/noGLuses.inc}
54 {$IFDEF ENABLE_HOLMES}
55 g_holmes, sdlcarcass, fui_ctls, fui_wadread, fui_style, fui_gfx_gl,
56 {$ENDIF}
57 {$IFDEF LINUX}
58 BaseUnix,
59 {$ENDIF}
60 {$IFDEF DARWIN}
61 MacOSAll, CocoaAll,
62 {$ENDIF}
63 {$IFDEF USE_SDL2}
64 SDL2,
65 {$ENDIF}
66 wadreader, e_log, g_window,
67 e_graphics, e_input, g_game, g_console, g_gui,
68 e_sound, g_options, g_sound, g_player, g_basic,
69 g_weapons, SysUtils, g_triggers, MAPDEF, g_map, e_res,
70 g_menu, g_language, g_net, g_touch, g_system, g_res_downloader,
71 conbuf, envvars,
72 xparser;
73
74
75 var
76 charbuff: packed array [0..15] of AnsiChar;
77 binPath: AnsiString = '';
78 forceBinDir: Boolean;
79
80 function GetBinaryPath (): AnsiString;
81 {$IFDEF LINUX}
82 var
83 //cd: AnsiString;
84 sl: AnsiString;
85 {$ENDIF}
86 begin
87 result := ExtractFilePath(ParamStr(0));
88 {$IFDEF LINUX}
89 // it may be a symlink; do some guesswork here
90 sl := fpReadLink(ExtractFileName(ParamStr(0)));
91 if (sl = ParamStr(0)) then
92 begin
93 // use current directory, as we don't have anything better
94 //result := '.';
95 GetDir(0, result);
96 end;
97 {$ENDIF}
98 result := fixSlashes(result);
99 if (length(result) > 0) and (result[length(result)] <> '/') then result := result+'/';
100 end;
101
102 procedure PrintDirs (msg: AnsiString; dirs: SSArray);
103 var dir: AnsiString;
104 begin
105 e_LogWriteln(msg + ':');
106 for dir in dirs do
107 e_LogWriteln(' ' + dir);
108 end;
109
110 {$IFDEF DARWIN}
111 function NSStringToAnsiString (s: NSString): AnsiString;
112 var i: Integer;
113 begin
114 result := '';
115 for i := 0 to s.length - 1 do
116 result := result + AnsiChar(s.characterAtIndex(i));
117 end;
118
119 function GetBundlePath (): AnsiString;
120 var pathRef: CFURLRef; pathCFStr: CFStringRef; pathStr: ShortString;
121 begin
122 pathRef := CFBundleCopyBundleURL(CFBundleGetMainBundle());
123 pathCFStr := CFURLCopyFileSystemPath(pathRef, kCFURLPOSIXPathStyle);
124 CFStringGetPascalString(pathCFStr, @pathStr, 255, CFStringGetSystemEncoding());
125 CFRelease(pathRef);
126 CFRelease(pathCFStr);
127 Result := pathStr;
128 end;
129 {$ENDIF}
130
131 procedure InitPath;
132 var i: Integer; rwdir, rodir: AnsiString; rwdirs, rodirs: SSArray;
133
134 procedure AddDir (var dirs: SSArray; append: AnsiString);
135 begin
136 SetLength(dirs, Length(dirs) + 1);
137 dirs[High(dirs)] := ExpandFileName(append)
138 end;
139
140 function IsSep (ch: Char): Boolean;
141 begin
142 {$IFDEF WINDOWS}
143 result := (ch = '/') or (ch = '\');
144 {$ELSE}
145 result := (ch = '/');
146 {$ENDIF}
147 end;
148
149 function OptimizePath (dir: AnsiString): AnsiString;
150 var i, len: Integer; s: AnsiString;
151 begin
152 i := 1; len := Length(dir); s := '';
153 while i <= len do
154 begin
155 if IsSep(dir[i]) then
156 begin
157 s := s + DirectorySeparator;
158 Inc(i);
159 while (i <= len) and IsSep(dir[i]) do Inc(i);
160 if (i <= len) and (dir[i] = '.') then
161 begin
162 if (i = len) or IsSep(dir[i + 1]) then
163 begin
164 Inc(i)
165 end
166 else if (i + 1 <= len) and (dir[i + 1] = '.') then
167 begin
168 if (i + 1 = len) or IsSep(dir[i + 2]) then
169 begin
170 s := e_UpperDir(s);
171 Inc(i, 2)
172 end
173 end
174 end
175 end
176 else
177 begin
178 s := s + dir[i];
179 Inc(i)
180 end
181 end;
182 result := s
183 end;
184
185 procedure OptimizeDirs (var dirs: SSArray);
186 var i, j, k: Integer;
187 begin
188 for i := 0 to High(dirs) do
189 dirs[i] := OptimizePath(dirs[i]);
190 // deduplicate
191 i := High(dirs);
192 while i >= 0 do
193 begin
194 j := 0;
195 while j < i do
196 begin
197 if dirs[j] = dirs[i] then
198 begin
199 for k := j + 1 to High(dirs) do
200 dirs[k - 1] := dirs[k];
201 Dec(i);
202 SetLength(dirs, High(dirs))
203 end
204 else
205 begin
206 Inc(j)
207 end
208 end;
209 Dec(i)
210 end
211 end;
212
213 procedure AddDef (var dirs: SSArray; base: SSArray; append: AnsiString);
214 var s: AnsiString;
215 begin
216 if Length(dirs) = 0 then
217 for s in base do
218 AddDir(dirs, e_CatPath(s, append));
219 OptimizeDirs(dirs)
220 end;
221
222 function GetDefaultRODirs (): SSArray;
223 {$IF DEFINED(UNIX) AND NOT DEFINED(DARWIN) AND NOT DEFINED(ANDROID)}
224 var home: AnsiString;
225 {$ENDIF}
226 {$IFDEF WINDOWS}
227 var appdata: AnsiString;
228 {$ENDIF}
229 {$IFDEF DARWIN}
230 var bundle, s: AnsiString; dirArr: NSArray; i: Integer;
231 {$ENDIF}
232 begin
233 result := nil;
234 {$IFDEF DARWIN}
235 bundle := GetBundlePath();
236 if ExtractFileExt(bundle) <> '.app' then
237 AddDir(result, binpath);
238 {$ELSE}
239 AddDir(result, binPath);
240 {$ENDIF}
241 if forceBinDir = false then
242 begin
243 {$IFDEF USE_SDL2}
244 AddDir(result, SDL_GetBasePath());
245 AddDir(result, SDL_GetPrefPath('', 'doom2df'));
246 {$ENDIF}
247 {$IFDEF WINDOWS}
248 appdata := GetEnvironmentVariable('APPDATA') + '\doom2df';
249 if appdata <> '' then
250 AddDir(result, appdata);
251 {$ENDIF}
252 {$IF DEFINED(UNIX) AND NOT DEFINED(DARWIN) AND NOT DEFINED(ANDROID)}
253 AddDir(result, '/usr/share/doom2df');
254 AddDir(result, '/usr/local/share/doom2df');
255 home := GetEnvironmentVariable('HOME');
256 if home <> '' then
257 AddDir(result, e_CatPath(home, '.doom2df'));
258 {$ENDIF}
259 {$IFDEF DARWIN}
260 bundle := GetBundlePath();
261 if bundle <> '' then
262 AddDir(result, e_CatPath(bundle, 'Contents/Resources'));
263 dirArr := NSSearchPathForDirectoriesInDomains(NSApplicationSupportDirectory, NSUserDomainMask, true);
264 for i := 0 to dirArr.count - 1 do
265 begin
266 s := NSStringToAnsiString(dirArr.objectAtIndex(i));
267 AddDir(result, e_CatPath(s, 'Doom 2D Forever'))
268 end;
269 {$ENDIF}
270 {$IF DEFINED(ANDROID) AND DEFINED(USE_SDL2)}
271 AddDir(result, SDL_AndroidGetInternalStoragePath());
272 if SDL_AndroidGetExternalStorageState() <> 0 then
273 AddDir(result, SDL_AndroidGetExternalStoragePath());
274 {$ENDIF}
275 end
276 end;
277
278 function GetDefaultRWDirs (): SSArray;
279 {$IF DEFINED(UNIX) AND NOT DEFINED(DARWIN) AND NOT DEFINED(ANDROID)}
280 var home: AnsiString;
281 {$ENDIF}
282 {$IFDEF WINDOWS}
283 var appdata: AnsiString;
284 {$ENDIF}
285 {$IFDEF DARWIN}
286 var bundle, s: AnsiString; dirArr: NSArray; i: Integer;
287 {$ENDIF}
288 begin
289 result := nil;
290 {$IFDEF DARWIN}
291 bundle := GetBundlePath();
292 if ExtractFileExt(bundle) <> '.app' then
293 AddDir(result, binPath);
294 {$ELSE}
295 AddDir(result, binPath);
296 {$ENDIF}
297 if forceBinDir = false then
298 begin
299 {$IFDEF USE_SDL2}
300 AddDir(result, SDL_GetPrefPath('', 'doom2df'));
301 {$ENDIF}
302 {$IFDEF WINDOWS}
303 appdata := GetEnvironmentVariable('APPDATA') + '\doom2df';
304 if appdata <> '' then
305 AddDir(result, appdata);
306 {$ENDIF}
307 {$IF DEFINED(UNIX) AND NOT DEFINED(DARWIN) AND NOT DEFINED(ANDROID)}
308 home := GetEnvironmentVariable('HOME');
309 if home <> '' then
310 AddDir(result, e_CatPath(home, '.doom2df'));
311 {$ENDIF}
312 {$IFDEF DARWIN}
313 dirArr := NSSearchPathForDirectoriesInDomains(NSApplicationSupportDirectory, NSUserDomainMask, true);
314 for i := 0 to dirArr.count - 1 do
315 begin
316 s := NSStringToAnsiString(dirArr.objectAtIndex(i));
317 AddDir(result, e_CatPath(s, 'Doom 2D Forever'))
318 end;
319 {$ENDIF}
320 {$IF DEFINED(ANDROID) AND DEFINED(USE_SDL2)}
321 if SDL_AndroidGetExternalStorageState() <> 0 then
322 AddDir(result, SDL_AndroidGetExternalStoragePath());
323 {$ENDIF}
324 end
325 end;
326
327 begin
328 forceBinDir := false;
329 binPath := GetBinaryPath();
330
331 i := 1;
332 while i < ParamCount do
333 begin
334 case ParamStr(i) of
335 '--like-windoze': forceBinDir := true;
336 '--rw-dir':
337 begin
338 Inc(i);
339 rwdir := ParamStr(i);
340 (* RW *)
341 AddDir(LogDirs, e_CatPath(rwdir, ''));
342 AddDir(SaveDirs, e_CatPath(rwdir, 'data'));
343 AddDir(CacheDirs, e_CatPath(rwdir, 'data/cache'));
344 AddDir(ConfigDirs, e_CatPath(rwdir, ''));
345 AddDir(MapDownloadDirs, e_CatPath(rwdir, 'maps/downloads'));
346 AddDir(WadDownloadDirs, e_CatPath(rwdir, 'wads/downloads'));
347 AddDir(ScreenshotDirs, e_CatPath(rwdir, 'screenshots'));
348 (* RO *)
349 AddDir(DataDirs, e_CatPath(rwdir, 'data'));
350 AddDir(ModelDirs, e_CatPath(rwdir, 'data/models'));
351 AddDir(MegawadDirs, e_CatPath(rwdir, 'maps/megawads'));
352 AddDir(MapDirs, e_CatPath(rwdir, 'maps'));
353 AddDir(WadDirs, e_CatPath(rwdir, 'wads'));
354 end;
355 '--ro-dir':
356 begin
357 Inc(i);
358 rodir := ParamStr(i);
359 (* RO *)
360 AddDir(DataDirs, e_CatPath(rodir, 'data'));
361 AddDir(ModelDirs, e_CatPath(rodir, 'data/models'));
362 AddDir(MegawadDirs, e_CatPath(rodir, 'maps/megawads'));
363 AddDir(MapDirs, e_CatPath(rodir, 'maps'));
364 AddDir(WadDirs, e_CatPath(rodir, 'wads'));
365 end;
366 end;
367 Inc(i)
368 end;
369
370 // prefer bin dir if it writable and contains game.wad
371 if forceBinDir = false then
372 begin
373 if findDiskWad(binPath + 'data' + '/' + 'GAME') <> '' then
374 if e_CanCreateFilesAt(binPath) then
375 forceBinDir := true
376 end;
377
378 (* RO *)
379 rodirs := GetDefaultRODirs();
380 AddDef(DataDirs, rodirs, 'data');
381 AddDef(ModelDirs, rodirs, 'data/models');
382 AddDef(MegawadDirs, rodirs, 'maps/megawads');
383 AddDef(MapDirs, rodirs, 'maps');
384 AddDef(WadDirs, rodirs, 'wads');
385
386 (* RW *)
387 rwdirs := GetDefaultRWDirs();
388 AddDef(LogDirs, rwdirs, '');
389 AddDef(SaveDirs, rwdirs, 'data');
390 AddDef(CacheDirs, rwdirs, 'data/cache');
391 AddDef(ConfigDirs, rwdirs, '');
392 AddDef(MapDownloadDirs, rwdirs, 'maps/downloads');
393 AddDef(WadDownloadDirs, rwdirs, 'wads/downloads');
394 AddDef(ScreenshotDirs, rwdirs, 'screenshots');
395
396 for i := 0 to High(MapDirs) do
397 AddDir(AllMapDirs, MapDirs[i]);
398 for i := 0 to High(MegawadDirs) do
399 AddDir(AllMapDirs, MegawadDirs[i]);
400 OptimizeDirs(AllMapDirs);
401
402 if LogFileName = '' then
403 begin
404 rwdir := e_GetWriteableDir(LogDirs, false);
405 if rwdir <> '' then
406 begin
407 {$IFDEF HEADLESS}
408 LogFileName := e_CatPath(rwdir, 'Doom2DF_H.log');
409 {$ELSE}
410 LogFileName := e_CatPath(rwdir, 'Doom2DF.log');
411 {$ENDIF}
412 end
413 end;
414 end;
415
416 procedure InitPrep;
417 {$IF DEFINED(ANDROID) AND DEFINED(USE_SDLMIXER)}
418 var timiditycfg: AnsiString;
419 {$ENDIF}
420 var i: Integer;
421 begin
422 {$IFDEF HEADLESS}
423 conbufDumpToStdOut := true;
424 {$ENDIF}
425 for i := 1 to ParamCount do
426 begin
427 if (ParamStr(i) = '--con-stdout') then
428 begin
429 conbufDumpToStdOut := true;
430 break
431 end
432 end;
433
434 if LogFileName <> '' then
435 e_InitLog(LogFileName, TWriteMode.WM_NEWFILE);
436 e_InitWritelnDriver();
437 e_WriteLog('Doom 2D: Forever version ' + GAME_VERSION + ' proto ' + IntToStr(NET_PROTOCOL_VER), TMsgType.Notify);
438 e_WriteLog('Build date: ' + GAME_BUILDDATE + ' ' + GAME_BUILDTIME, TMsgType.Notify);
439 e_WriteLog('Build hash: ' + g_GetBuildHash(), TMsgType.Notify);
440 e_WriteLog('Build by: ' + g_GetBuilderName(), TMsgType.Notify);
441
442 e_LogWritefln('Force bin dir: %s', [forceBinDir], TMsgType.Notify);
443 e_LogWritefln('BINARY PATH: [%s]', [binPath], TMsgType.Notify);
444
445 PrintDirs('DataDirs', DataDirs);
446 PrintDirs('ModelDirs', ModelDirs);
447 PrintDirs('MegawadDirs', MegawadDirs);
448 PrintDirs('MapDirs', MapDirs);
449 PrintDirs('WadDirs', WadDirs);
450
451 PrintDirs('LogDirs', LogDirs);
452 PrintDirs('SaveDirs', SaveDirs);
453 PrintDirs('CacheDirs', CacheDirs);
454 PrintDirs('ConfigDirs', ConfigDirs);
455 PrintDirs('ScreenshotDirs', ScreenshotDirs);
456 PrintDirs('MapDownloadDirs', MapDownloadDirs);
457 PrintDirs('WadDownloadDirs', WadDownloadDirs);
458
459 GameWAD := e_FindWad(DataDirs, 'GAME');
460 if GameWad = '' then
461 begin
462 e_WriteLog('GAME.WAD not installed?', TMsgType.Fatal);
463 {$IF DEFINED(USE_SDL2) AND NOT DEFINED(HEADLESS)}
464 if forceBinDir = false then
465 SDL_ShowSimpleMessageBox(SDL_MESSAGEBOX_ERROR, 'Doom 2D Forever', 'GAME.WAD not installed?', nil);
466 {$ENDIF}
467 e_DeinitLog;
468 Halt(1);
469 end;
470
471 {$IF DEFINED(ANDROID) AND DEFINED(USE_SDLMIXER)}
472 timiditycfg := 'timidity.cfg';
473 if e_FindResource(ConfigDirs, timiditycfg) = true then
474 begin
475 timiditycfg := ExpandFileName(timiditycfg);
476 SetEnvVar('TIMIDITY_CFG', timiditycfg);
477 e_LogWritefln('Set TIMIDITY_CFG = "%s"', [timiditycfg]);
478 end;
479 {$ENDIF}
480 end;
481
482 procedure Main();
483 {$IFDEF ENABLE_HOLMES}
484 var flexloaded: Boolean;
485 {$ENDIF}
486 var s: AnsiString;
487 begin
488 InitPath;
489 InitPrep;
490 e_InitInput;
491 sys_Init;
492
493 s := CONFIG_FILENAME;
494 if e_FindResource(ConfigDirs, s) = true then
495 begin
496 g_Options_Read(s)
497 end
498 else
499 begin
500 g_Options_SetDefault;
501 g_Options_SetDefaultVideo
502 end;
503 if sys_SetDisplayMode(gScreenWidth, gScreenHeight, gBPP, gFullScreen) = False then
504 raise Exception.Create('Failed to set videomode on startup.');
505
506 g_Console_SysInit;
507 e_WriteLog(gLanguage, TMsgType.Notify);
508 g_Language_Set(gLanguage);
509
510 {$IF not DEFINED(HEADLESS) and DEFINED(ENABLE_HOLMES)}
511 flexloaded := true;
512 if not fuiAddWad('flexui.wad') then
513 begin
514 if not fuiAddWad('./data/flexui.wad') then fuiAddWad('./flexui.wad');
515 end;
516 try
517 fuiGfxLoadFont('win8', 'flexui/fonts/win8.fuifont');
518 fuiGfxLoadFont('win14', 'flexui/fonts/win14.fuifont');
519 fuiGfxLoadFont('win16', 'flexui/fonts/win16.fuifont');
520 fuiGfxLoadFont('dos8', 'flexui/fonts/dos8.fuifont');
521 fuiGfxLoadFont('msx6', 'flexui/fonts/msx6.fuifont');
522 except on e: Exception do
523 begin
524 writeln('ERROR loading FlexUI fonts');
525 flexloaded := false;
526 //raise;
527 end;
528 else
529 begin
530 flexloaded := false;
531 //raise;
532 end;
533 end;
534 if (flexloaded) then
535 begin
536 try
537 e_LogWriteln('FlexUI: loading stylesheet...');
538 uiLoadStyles('flexui/widgets.wgs');
539 except on e: TParserException do
540 begin
541 writeln('ERROR at (', e.tokLine, ',', e.tokCol, '): ', e.message);
542 //raise;
543 flexloaded := false;
544 end;
545 else
546 begin
547 //raise;
548 flexloaded := false;
549 end;
550 end;
551 end;
552 g_holmes_imfunctional := not flexloaded;
553
554 if (not g_holmes_imfunctional) then
555 begin
556 uiInitialize();
557 uiContext.font := 'win14';
558 end;
559
560 if assigned(oglInitCB) then oglInitCB;
561 {$ENDIF}
562
563 //g_Res_CreateDatabases(true); // it will be done before connecting to the server for the first time
564
565 e_WriteLog('Entering SDLMain', TMsgType.Notify);
566
567 {$WARNINGS OFF}
568 SDLMain();
569 {$WARNINGS ON}
570
571 {$IFDEF ENABLE_HOLMES}
572 if assigned(oglDeinitCB) then oglDeinitCB;
573 {$ENDIF}
574
575 sys_Final;
576 end;
577
578 procedure Init();
579 var
580 NoSound: Boolean;
581 begin
582 Randomize;
583
584 {$IFDEF HEADLESS}
585 {$IFDEF USE_SDLMIXER}
586 NoSound := False; // hope env has set SDL_AUDIODRIVER to dummy
587 {$ELSE}
588 NoSound := True; // FMOD backend will sort it out
589 {$ENDIF}
590 {$ELSE}
591 NoSound := False;
592 {$ENDIF}
593
594 g_Touch_Init;
595
596 (*
597 if (e_JoysticksAvailable > 0) then
598 e_WriteLog('Input: Joysticks available.', TMsgType.Notify)
599 else
600 e_WriteLog('Input: No Joysticks.', TMsgType.Notify);
601 *)
602
603 if (not gNoSound) then
604 begin
605 e_WriteLog('Initializing sound system', TMsgType.Notify);
606 e_InitSoundSystem(NoSound);
607 end;
608
609 e_WriteLog('Init game', TMsgType.Notify);
610 g_Game_Init();
611
612 FillChar(charbuff, sizeof(charbuff), ' ');
613 end;
614
615
616 procedure Release();
617 begin
618 e_WriteLog('Releasing engine', TMsgType.Notify);
619 e_ReleaseEngine();
620
621 e_WriteLog('Releasing input', TMsgType.Notify);
622 e_ReleaseInput();
623
624 if not gNoSound then
625 begin
626 e_WriteLog('Releasing sound', TMsgType.Notify);
627 e_ReleaseSoundSystem();
628 end;
629 end;
630
631
632 procedure Update ();
633 begin
634 g_Game_Update();
635 end;
636
637
638 procedure Draw ();
639 begin
640 g_Game_Draw();
641 end;
642
643
644 function Translit (const S: AnsiString): AnsiString;
645 var
646 i: Integer;
647 begin
648 Result := S;
649 for i := 1 to Length(Result) do
650 begin
651 case Result[i] of
652 'É': Result[i] := 'Q';
653 'Ö': Result[i] := 'W';
654 'Ó': Result[i] := 'E';
655 'Ê': Result[i] := 'R';
656 'Å': Result[i] := 'T';
657 'Í': Result[i] := 'Y';
658 'Ã': Result[i] := 'U';
659 'Ø': Result[i] := 'I';
660 'Ù': Result[i] := 'O';
661 'Ç': Result[i] := 'P';
662 'Õ': Result[i] := '['; //Chr(219);
663 'Ú': Result[i] := ']'; //Chr(221);
664 'Ô': Result[i] := 'A';
665 'Û': Result[i] := 'S';
666 'Â': Result[i] := 'D';
667 'À': Result[i] := 'F';
668 'Ï': Result[i] := 'G';
669 'Ð': Result[i] := 'H';
670 'Î': Result[i] := 'J';
671 'Ë': Result[i] := 'K';
672 'Ä': Result[i] := 'L';
673 'Æ': Result[i] := ';'; //Chr(186);
674 'Ý': Result[i] := #39; //Chr(222);
675 'ß': Result[i] := 'Z';
676 '×': Result[i] := 'X';
677 'Ñ': Result[i] := 'C';
678 'Ì': Result[i] := 'V';
679 'È': Result[i] := 'B';
680 'Ò': Result[i] := 'N';
681 'Ü': Result[i] := 'M';
682 'Á': Result[i] := ','; //Chr(188);
683 'Þ': Result[i] := '.'; //Chr(190);
684 end;
685 end;
686 end;
687
688
689 function CheckCheat (ct: TStrings_Locale; eofs: Integer=0): Boolean;
690 var
691 ls1, ls2: string;
692 begin
693 ls1 := CheatEng[ct];
694 ls2 := Translit(CheatRus[ct]);
695 if length(ls1) = 0 then ls1 := '~';
696 if length(ls2) = 0 then ls2 := '~';
697 result :=
698 (Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)) = ls1) or
699 (Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))) = ls1) or
700 (Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)) = ls2) or
701 (Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))) = ls2);
702 {
703 if ct = I_GAME_CHEAT_JETPACK then
704 begin
705 e_WriteLog('ls1: ['+ls1+']', MSG_NOTIFY);
706 e_WriteLog('ls2: ['+ls2+']', MSG_NOTIFY);
707 e_WriteLog('bf0: ['+Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))+']', MSG_NOTIFY);
708 e_WriteLog('bf1: ['+Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)))+']', MSG_NOTIFY);
709 e_WriteLog('bf2: ['+Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))+']', MSG_NOTIFY);
710 e_WriteLog('bf3: ['+Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)))+']', MSG_NOTIFY);
711 end;
712 }
713 end;
714
715
716 procedure Cheat ();
717 const
718 CHEAT_DAMAGE = 500;
719 label
720 Cheated;
721 var
722 s, s2: string;
723 c: ShortString;
724 a: Integer;
725 begin
726 {
727 if (not gGameOn) or (not gCheats) or ((gGameSettings.GameType <> GT_SINGLE) and
728 (gGameSettings.GameMode <> GM_COOP) and (not gDebugMode))
729 or g_Game_IsNet then Exit;
730 }
731 if not gGameOn then exit;
732 if not conIsCheatsEnabled then exit;
733
734 s := 'SOUND_GAME_RADIO';
735
736 //
737 if CheckCheat(I_GAME_CHEAT_GODMODE) then
738 begin
739 if gPlayer1 <> nil then gPlayer1.GodMode := not gPlayer1.GodMode;
740 if gPlayer2 <> nil then gPlayer2.GodMode := not gPlayer2.GodMode;
741 goto Cheated;
742 end;
743 // RAMBO
744 if CheckCheat(I_GAME_CHEAT_WEAPONS) then
745 begin
746 if gPlayer1 <> nil then gPlayer1.AllRulez(False);
747 if gPlayer2 <> nil then gPlayer2.AllRulez(False);
748 goto Cheated;
749 end;
750 // TANK
751 if CheckCheat(I_GAME_CHEAT_HEALTH) then
752 begin
753 if gPlayer1 <> nil then gPlayer1.AllRulez(True);
754 if gPlayer2 <> nil then gPlayer2.AllRulez(True);
755 goto Cheated;
756 end;
757 // IDDQD
758 if CheckCheat(I_GAME_CHEAT_DEATH) then
759 begin
760 if gPlayer1 <> nil then gPlayer1.Damage(CHEAT_DAMAGE, 0, 0, 0, HIT_TRAP);
761 if gPlayer2 <> nil then gPlayer2.Damage(CHEAT_DAMAGE, 0, 0, 0, HIT_TRAP);
762 s := 'SOUND_MONSTER_HAHA';
763 goto Cheated;
764 end;
765 //
766 if CheckCheat(I_GAME_CHEAT_DOORS) then
767 begin
768 g_Triggers_OpenAll();
769 goto Cheated;
770 end;
771 // GOODBYE
772 if CheckCheat(I_GAME_CHEAT_NEXTMAP) then
773 begin
774 if gTriggers <> nil then
775 for a := 0 to High(gTriggers) do
776 if gTriggers[a].TriggerType = TRIGGER_EXIT then
777 begin
778 gExitByTrigger := True;
779 //g_Game_ExitLevel(gTriggers[a].Data.MapName);
780 g_Game_ExitLevel(gTriggers[a].tgcMap);
781 Break;
782 end;
783 goto Cheated;
784 end;
785 //
786 s2 := Copy(charbuff, 15, 2);
787 if CheckCheat(I_GAME_CHEAT_CHANGEMAP, 2) and (s2[1] >= '0') and (s2[1] <= '9') and (s2[2] >= '0') and (s2[2] <= '9') then
788 begin
789 if g_Map_Exist(gGameSettings.WAD + ':\MAP' + s2) then
790 begin
791 c := 'MAP' + s2;
792 g_Game_ExitLevel(c);
793 end;
794 goto Cheated;
795 end;
796 //
797 if CheckCheat(I_GAME_CHEAT_FLY) then
798 begin
799 gFly := not gFly;
800 goto Cheated;
801 end;
802 // BULLFROG
803 if CheckCheat(I_GAME_CHEAT_JUMPS) then
804 begin
805 VEL_JUMP := 30-VEL_JUMP;
806 goto Cheated;
807 end;
808 // FORMULA1
809 if CheckCheat(I_GAME_CHEAT_SPEED) then
810 begin
811 MAX_RUNVEL := 32-MAX_RUNVEL;
812 goto Cheated;
813 end;
814 // CONDOM
815 if CheckCheat(I_GAME_CHEAT_SUIT) then
816 begin
817 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_SUIT);
818 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_SUIT);
819 goto Cheated;
820 end;
821 //
822 if CheckCheat(I_GAME_CHEAT_AIR) then
823 begin
824 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_OXYGEN);
825 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_OXYGEN);
826 goto Cheated;
827 end;
828 // PURELOVE
829 if CheckCheat(I_GAME_CHEAT_BERSERK) then
830 begin
831 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_MEDKIT_BLACK);
832 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_MEDKIT_BLACK);
833 goto Cheated;
834 end;
835 //
836 if CheckCheat(I_GAME_CHEAT_JETPACK) then
837 begin
838 if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_JETPACK);
839 if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_JETPACK);
840 goto Cheated;
841 end;
842 // CASPER
843 if CheckCheat(I_GAME_CHEAT_NOCLIP) then
844 begin
845 if gPlayer1 <> nil then gPlayer1.SwitchNoClip;
846 if gPlayer2 <> nil then gPlayer2.SwitchNoClip;
847 goto Cheated;
848 end;
849 //
850 if CheckCheat(I_GAME_CHEAT_NOTARGET) then
851 begin
852 if gPlayer1 <> nil then gPlayer1.NoTarget := not gPlayer1.NoTarget;
853 if gPlayer2 <> nil then gPlayer2.NoTarget := not gPlayer2.NoTarget;
854 goto Cheated;
855 end;
856 // INFERNO
857 if CheckCheat(I_GAME_CHEAT_NORELOAD) then
858 begin
859 if gPlayer1 <> nil then gPlayer1.NoReload := not gPlayer1.NoReload;
860 if gPlayer2 <> nil then gPlayer2.NoReload := not gPlayer2.NoReload;
861 goto Cheated;
862 end;
863 if CheckCheat(I_GAME_CHEAT_AIMLINE) then
864 begin
865 gAimLine := not gAimLine;
866 goto Cheated;
867 end;
868 if CheckCheat(I_GAME_CHEAT_AUTOMAP) then
869 begin
870 gShowMap := not gShowMap;
871 goto Cheated;
872 end;
873 Exit;
874
875 Cheated:
876 g_Sound_PlayEx(s);
877 end;
878
879
880 procedure KeyPress (K: Word);
881 {$IFNDEF HEADLESS}
882 var
883 Msg: g_gui.TMessage;
884 {$ENDIF}
885 begin
886 {$IFNDEF HEADLESS}
887 case K of
888 VK_ESCAPE: // <Esc>:
889 begin
890 if (g_ActiveWindow <> nil) then
891 begin
892 Msg.Msg := WM_KEYDOWN;
893 Msg.WParam := VK_ESCAPE;
894 g_ActiveWindow.OnMessage(Msg);
895 if (not g_Game_IsNet) and (g_ActiveWindow = nil) then g_Game_Pause(false); //Fn loves to do this
896 end
897 else if (gState <> STATE_FOLD) then
898 begin
899 if gGameOn or (gState = STATE_INTERSINGLE) or (gState = STATE_INTERCUSTOM) then
900 begin
901 g_Game_InGameMenu(True);
902 end
903 else if (gExit = 0) and (gState <> STATE_SLIST) then
904 begin
905 if (gState <> STATE_MENU) then
906 begin
907 if (NetMode <> NET_NONE) then
908 begin
909 g_Game_StopAllSounds(True);
910 g_Game_Free;
911 gState := STATE_MENU;
912 Exit;
913 end;
914 end;
915 g_GUI_ShowWindow('MainMenu');
916 g_Sound_PlayEx('MENU_OPEN');
917 end;
918 end;
919 end;
920
921 IK_F2, IK_F3, IK_F4, IK_F5, IK_F6, IK_F7, IK_F10:
922 begin // <F2> .. <F6> � <F12>
923 if gGameOn and (not gConsoleShow) and (not gChatShow) then
924 begin
925 while (g_ActiveWindow <> nil) do g_GUI_HideWindow(False);
926 if (not g_Game_IsNet) then g_Game_Pause(True);
927 case K of
928 IK_F2: g_Menu_Show_SaveMenu();
929 IK_F3: g_Menu_Show_LoadMenu();
930 IK_F4: g_Menu_Show_GameSetGame();
931 IK_F5: g_Menu_Show_OptionsVideo();
932 IK_F6: g_Menu_Show_OptionsSound();
933 IK_F7: g_Menu_Show_EndGameMenu();
934 IK_F10: g_Menu_Show_QuitGameMenu();
935 end;
936 end;
937 end;
938
939 else
940 begin
941 gJustChatted := False;
942 if gConsoleShow or gChatShow then
943 begin
944 g_Console_Control(K);
945 end
946 else if (g_ActiveWindow <> nil) then
947 begin
948 Msg.Msg := WM_KEYDOWN;
949 Msg.WParam := K;
950 g_ActiveWindow.OnMessage(Msg);
951 end
952 else if (gState = STATE_MENU) then
953 begin
954 g_GUI_ShowWindow('MainMenu');
955 g_Sound_PlayEx('MENU_OPEN');
956 end;
957 end;
958 end;
959 {$ENDIF}
960 end;
961
962
963 procedure CharPress (C: AnsiChar);
964 var
965 Msg: g_gui.TMessage;
966 a: Integer;
967 begin
968 if gConsoleShow or gChatShow then
969 begin
970 g_Console_Char(C)
971 end
972 else if (g_ActiveWindow <> nil) then
973 begin
974 Msg.Msg := WM_CHAR;
975 Msg.WParam := Ord(C);
976 g_ActiveWindow.OnMessage(Msg);
977 end
978 else
979 begin
980 for a := 0 to 14 do charbuff[a] := charbuff[a+1];
981 charbuff[15] := upcase1251(C);
982 Cheat();
983 end;
984 end;
985
986 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024