DEADSOFTWARE

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