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 {$IFDEF ANDROID}library{$ELSE}program{$ENDIF} Doom2DF;
18 {$IFNDEF HEADLESS}
19 {$IFDEF WINDOWS}
20 {$APPTYPE GUI}
21 {$ENDIF}
22 {$ENDIF}
23 {$HINTS OFF}
25 uses
26 {$IFDEF ANDROID}
27 ctypes, jni,
28 {$ENDIF}
29 {$IFDEF UNIX}
30 cthreads, BaseUnix,
31 {$ENDIF}
32 {$IFDEF DARWIN}
33 MacOSAll, CocoaAll,
34 {$ENDIF}
35 mempool in '../shared/mempool.pas',
36 conbuf in '../shared/conbuf.pas',
37 geom in '../shared/geom.pas',
38 math,
40 {$IFDEF USE_MINIUPNPC}
41 miniupnpc in '../lib/miniupnpc/miniupnpc.pas',
42 {$ENDIF}
44 {$IFDEF USE_SDL}
45 SDL in '../lib/sdl/sdl.pas',
46 {$IFDEF USE_SDLMIXER}
47 SDL_mixer in '../lib/sdl/sdl_mixer.pas',
48 {$ENDIF}
49 {$ENDIF}
50 {$IFDEF USE_SDL2}
51 SDL2 in '../lib/sdl2/sdl2.pas',
52 {$IFDEF USE_SDLMIXER}
53 SDL2_mixer in '../lib/sdl2/SDL2_mixer.pas',
54 {$ENDIF}
55 {$ENDIF}
56 {$IFDEF USE_SYSSTUB}
57 {$IFDEF USE_SDLMIXER}
58 SDL2 in '../lib/sdl2/sdl2.pas',
59 SDL2_mixer in '../lib/sdl2/SDL2_mixer.pas',
60 {$ENDIF}
61 {$ENDIF}
63 {$IFDEF USE_OPENAL}
64 AL in '../lib/openal/al.pas',
65 e_soundfile in '../engine/e_soundfile.pas',
66 {$IF DEFINED(USE_SDL) OR DEFINED(USE_SDL2)}
67 e_soundfile_wav in '../engine/e_soundfile_wav.pas',
68 {$ENDIF}
69 {$IFDEF USE_VORBIS}
70 vorbis in '../lib/vorbis/vorbis.pas',
71 e_soundfile_vorbis in '../engine/e_soundfile_vorbis.pas',
72 {$ENDIF}
73 {$IFDEF USE_FLUIDSYNTH}
74 fluidsynth in '../lib/fluidsynth/fluidsynth.pas',
75 e_soundfile_fluid in '../engine/e_soundfile_fluid.pas',
76 {$ENDIF}
77 {$IFDEF USE_MODPLUG}
78 modplug in '../lib/modplug/modplug.pas',
79 e_soundfile_modplug in '../engine/e_soundfile_modplug.pas',
80 {$ENDIF}
81 {$IFDEF USE_XMP}
82 xmp in '../lib/xmp/xmp.pas',
83 e_soundfile_xmp in '../engine/e_soundfile_xmp.pas',
84 {$ENDIF}
85 {$IFDEF USE_GME}
86 gme in '../lib/gme/gme.pas',
87 e_soundfile_gme in '../engine/e_soundfile_gme.pas',
88 {$ENDIF}
89 {$IFDEF USE_MPG123}
90 mpg123 in '../lib/mpg123/mpg123.pas',
91 e_soundfile_mp3 in '../engine/e_soundfile_mp3.pas',
92 {$ENDIF}
93 {$IFDEF USE_OPUS}
94 opus in '../lib/opus/opus.pas',
95 e_soundfile_opus in '../engine/e_soundfile_opus.pas',
96 {$ENDIF}
97 {$IF DEFINED(USE_VORBIS) OR DEFINED(USE_OPUS)}
98 ogg in '../lib/vorbis/ogg.pas', // this has to come last because link order
99 {$ENDIF}
100 {$ENDIF}
102 ENet in '../lib/enet/enet.pp',
103 e_input in '../engine/e_input.pas',
104 e_log in '../engine/e_log.pas',
105 e_sound in '../engine/e_sound.pas',
106 e_msg in '../engine/e_msg.pas',
107 e_res in '../engine/e_res.pas',
108 utils in '../shared/utils.pas',
109 xstreams in '../shared/xstreams.pas',
110 sfs in '../sfs/sfs.pas',
111 sfsPlainFS in '../sfs/sfsPlainFS.pas',
112 sfsZipFS in '../sfs/sfsZipFS.pas',
113 wadreader in '../shared/wadreader.pas',
114 MAPDEF in '../shared/MAPDEF.pas',
115 CONFIG in '../shared/CONFIG.pas',
116 g_base in 'g_base.pas',
117 g_basic in 'g_basic.pas',
118 g_console in 'g_console.pas',
119 g_net in 'g_net.pas',
120 g_netmsg in 'g_netmsg.pas',
121 g_nethandler in 'g_nethandler.pas',
122 g_netmaster in 'g_netmaster.pas',
123 g_res_downloader in 'g_res_downloader.pas',
124 g_grid in 'g_grid.pas',
125 g_game in 'g_game.pas',
126 g_gfx in 'g_gfx.pas',
127 g_gui in 'g_gui.pas',
128 g_items in 'g_items.pas',
129 g_map in 'g_map.pas',
130 g_menu in 'g_menu.pas',
131 g_monsters in 'g_monsters.pas',
132 g_options in 'g_options.pas',
133 g_phys in 'g_phys.pas',
134 g_player in 'g_player.pas',
135 g_playermodel in 'g_playermodel.pas',
136 g_saveload in 'g_saveload.pas',
137 g_sound in 'g_sound.pas',
138 g_textures in 'g_textures.pas',
139 g_triggers in 'g_triggers.pas',
140 g_weapons in 'g_weapons.pas',
141 g_window in 'g_window.pas',
142 {$IFDEF USE_SYSSTUB}
143 g_system in 'stub/g_system.pas',
144 g_touch in 'stub/g_touch.pas',
145 {$ENDIF}
146 {$IFDEF USE_SDL}
147 g_system in 'sdl/g_system.pas',
148 g_touch in 'sdl/g_touch.pas',
149 {$ENDIF}
150 {$IFDEF USE_SDL2}
151 g_system in 'sdl2/g_system.pas',
152 g_touch in 'sdl2/g_touch.pas',
153 {$ENDIF}
155 r_animations in 'opengl/r_animations.pas',
156 r_console in 'opengl/r_console.pas',
157 r_game in 'opengl/r_game.pas',
158 r_gfx in 'opengl/r_gfx.pas',
159 r_graphics in 'opengl/r_graphics.pas',
160 r_items in 'opengl/r_items.pas',
161 r_map in 'opengl/r_map.pas',
162 r_monsters in 'opengl/r_monsters.pas',
163 r_netmaster in 'opengl/r_netmaster.pas',
164 r_panel in 'opengl/r_panel.pas',
165 r_player in 'opengl/r_player.pas',
166 r_playermodel in 'opengl/r_playermodel.pas',
167 r_render in 'opengl/r_render.pas',
168 r_texture in 'opengl/r_texture.pas',
169 r_textures in 'opengl/r_textures.pas',
170 r_weapons in 'opengl/r_weapons.pas',
171 r_window in 'opengl/r_window.pas',
173 {$IFDEF USE_FMOD}
174 fmod in '../lib/FMOD/fmod.pas',
175 fmoderrors in '../lib/FMOD/fmoderrors.pas',
176 fmodpresets in '../lib/FMOD/fmodpresets.pas',
177 fmodtypes in '../lib/FMOD/fmodtypes.pas',
178 {$ENDIF}
179 xprofiler in '../shared/xprofiler.pas',
180 binheap in '../shared/binheap.pas',
181 hashtable in '../shared/hashtable.pas',
182 fhashdb in '../shared/fhashdb.pas',
183 idpool in '../shared/idpool.pas',
184 xparser in '../shared/xparser.pas',
185 xdynrec in '../shared/xdynrec.pas',
186 exoma in '../shared/exoma.pas',
187 envvars in '../shared/envvars.pas',
188 g_panel in 'g_panel.pas',
189 g_language in 'g_language.pas',
191 {$IFDEF ENABLE_HOLMES}
192 g_holmes in 'g_holmes.pas',
194 sdlcarcass in '../flexui/sdlcarcass.pas',
195 //sdlstandalone in '../flexui/sdlstandalone.pas',
197 fui_wadread in '../flexui/fui_wadread.pas',
198 fui_common in '../flexui/fui_common.pas',
199 fui_gfx_gl in '../flexui/fui_gfx_gl.pas',
200 fui_events in '../flexui/fui_events.pas',
201 fui_style in '../flexui/fui_style.pas',
202 fui_flexlay in '../flexui/fui_flexlay.pas',
203 fui_ctls in '../flexui/fui_ctls.pas',
204 {$ENDIF}
205 {$I ../shared/vampimg.inc}
207 SysUtils, Classes;
209 {$IFDEF WINDOWS}
210 {$R *.res}
211 {$ENDIF}
213 const
214 autoexecScript = 'autoexec.cfg';
216 var
217 noct: Boolean = False;
218 binPath: AnsiString = '';
219 forceBinDir: Boolean = False;
220 {$IFDEF USE_SDLMIXER}
221 UseNativeMusic: Boolean;
222 {$ENDIF}
224 Time_Old: Int64;
225 NoSound: Boolean;
227 procedure Update ();
228 begin
229 // remember old mobj positions, prepare for update
230 g_Game_PreUpdate();
231 // server: receive client commands for new frame
232 // client: receive game state changes from server
233 if (NetMode = NET_SERVER) then g_Net_Host_Update()
234 else if (NetMode = NET_CLIENT) then g_Net_Client_Update();
235 // think
236 g_Game_Update();
237 // server: send any accumulated outgoing data to clients
238 if NetMode = NET_SERVER then g_Net_Flush();
239 end;
241 function ProcessMessage (): Boolean;
242 var
243 i, t: Integer;
244 flag: Boolean;
245 Time, Time_Delta: Int64;
246 Frame: Int64;
247 begin
248 result := sys_HandleInput();
250 Time := GetTickCount64();
251 Time_Delta := Time-Time_Old;
253 flag := false;
255 if wNeedTimeReset then
256 begin
257 Frame := 0;
258 Time_Delta := 28;
259 wNeedTimeReset := false;
260 end;
262 g_Map_ProfilersBegin();
263 g_Mons_ProfilersBegin();
265 t := Time_Delta div 28;
266 if (t > 0) then
267 begin
268 flag := true;
269 for i := 1 to t do
270 Update();
271 end;
273 g_Map_ProfilersEnd();
274 g_Mons_ProfilersEnd();
276 if (gExit = EXIT_QUIT) then
277 begin
278 result := true;
279 exit;
280 end;
282 // Время предыдущего обновления
283 if flag then
284 Time_Old := Time - (Time_Delta mod 28);
286 // don't wait if VSync is on, GL already probably waits enough
287 if gLerpActors then
288 flag := (Time - Frame >= gFrameTime) or gVSync;
290 if flag then
291 begin
292 if gPause or (not gLerpActors) or (gState = STATE_FOLD) then
293 gLerpFactor := 1.0
294 else
295 gLerpFactor := nmin(1.0, (Time - Time_Old) / 28.0);
296 r_Game_Draw;
297 sys_Repaint;
298 Frame := Time
299 end
300 else
301 Sleep(1);
303 e_SoundUpdate();
304 end;
306 procedure DebugOptions;
307 var
308 idx: Integer;
309 arg: AnsiString;
310 mdfo: TStream;
311 {$IFDEF ENABLE_HOLMES}
312 itmp: Integer;
313 valres: Word;
314 {$ENDIF}
315 begin
316 idx := 1;
317 while (idx <= ParamCount) do
318 begin
319 arg := ParamStr(idx);
320 Inc(idx);
321 //if arg = '--twinkletwinkle' then gwin_k8_enable_light_experiments := true;
322 if arg = '--jah' then g_profile_history_size := 100;
323 if arg = '--no-particles' then gpart_dbg_enabled := false;
324 if arg = '--no-los' then gmon_dbg_los_enabled := false;
326 if arg = '--profile-render' then g_profile_frame_draw := true;
327 if arg = '--profile-coldet' then g_profile_collision := true;
328 if arg = '--profile-los' then g_profile_los := true;
330 if arg = '--no-part-phys' then gpart_dbg_phys_enabled := false;
331 if arg = '--no-part-physics' then gpart_dbg_phys_enabled := false;
332 if arg = '--no-particles-phys' then gpart_dbg_phys_enabled := false;
333 if arg = '--no-particles-physics' then gpart_dbg_phys_enabled := false;
334 if arg = '--no-particle-phys' then gpart_dbg_phys_enabled := false;
335 if arg = '--no-particle-physics' then gpart_dbg_phys_enabled := false;
337 if arg = '--debug-input' then g_dbg_input := True;
339 {.$IF DEFINED(D2F_DEBUG)}
340 if arg = '--aimline' then g_dbg_aimline_on := true;
341 {.$ENDIF}
343 {$IFDEF ENABLE_HOLMES}
344 if arg = '--holmes' then begin g_holmes_enabled := true; g_Game_SetDebugMode(); end;
346 if (arg = '--holmes-ui-scale') or (arg = '-holmes-ui-scale') then
347 begin
348 if (idx <= ParamCount) then
349 begin
350 if not conParseFloat(fuiRenderScale, ParamStr(idx)) then fuiRenderScale := 1.0;
351 Inc(idx);
352 end;
353 end;
355 if (arg = '--holmes-font') or (arg = '-holmes-font') then
356 begin
357 if (idx <= ParamCount) then
358 begin
359 itmp := 0;
360 val(ParamStr(idx), itmp, valres);
361 {$IFNDEF HEADLESS}
362 if (valres = 0) and (not g_holmes_imfunctional) then
363 begin
364 case itmp of
365 8: uiContext.font := 'win8';
366 14: uiContext.font := 'win14';
367 16: uiContext.font := 'win16';
368 end;
369 end;
370 {$ELSE}
371 // fuck off, fpc!
372 itmp := itmp;
373 valres := valres;
374 {$ENDIF}
375 Inc(idx);
376 end;
377 end;
378 {$ENDIF}
380 if (arg = '--game-scale') or (arg = '-game-scale') then
381 begin
382 if (idx <= ParamCount) then
383 begin
384 if not conParseFloat(g_dbg_scale, ParamStr(idx)) then g_dbg_scale := 1.0;
385 Inc(idx);
386 end;
387 end;
389 if (arg = '--write-mapdef') or (arg = '-write-mapdef') then
390 begin
391 mdfo := createDiskFile('mapdef.txt');
392 mdfo.WriteBuffer(defaultMapDef[1], Length(defaultMapDef));
393 mdfo.Free();
394 Halt(0);
395 end;
397 if (arg = '--pixel-scale') or (arg = '-pixel-scale') then
398 begin
399 if (idx <= ParamCount) then
400 begin
401 if not conParseFloat(r_pixel_scale, ParamStr(idx)) then r_pixel_scale := 1.0;
402 Inc(idx);
403 end;
404 end;
405 end;
406 end;
408 function GetBinaryPath (): AnsiString;
409 {$IFDEF LINUX}
410 var sl: AnsiString;
411 {$ENDIF}
412 begin
413 result := ExtractFilePath(ParamStr(0));
414 {$IFDEF LINUX}
415 // it may be a symlink; do some guesswork here
416 sl := fpReadLink(ExtractFileName(ParamStr(0)));
417 if (sl = ParamStr(0)) then
418 begin
419 // use current directory, as we don't have anything better
420 //result := '.';
421 GetDir(0, result);
422 end;
423 {$ENDIF}
424 result := fixSlashes(result);
425 if (length(result) > 0) and (result[length(result)] <> '/') then
426 result := result + '/';
427 end;
429 procedure PrintDirs (msg: AnsiString; dirs: SSArray);
430 var dir: AnsiString;
431 begin
432 e_LogWriteln(msg + ':');
433 for dir in dirs do
434 e_LogWriteln(' ' + dir);
435 end;
437 {$IFDEF DARWIN}
438 function NSStringToAnsiString (s: NSString): AnsiString;
439 var i: Integer;
440 begin
441 result := '';
442 for i := 0 to s.length - 1 do
443 result := result + AnsiChar(s.characterAtIndex(i));
444 end;
446 function GetBundlePath (): AnsiString;
447 var pathRef: CFURLRef; pathCFStr: CFStringRef; pathStr: ShortString;
448 begin
449 pathRef := CFBundleCopyBundleURL(CFBundleGetMainBundle());
450 pathCFStr := CFURLCopyFileSystemPath(pathRef, kCFURLPOSIXPathStyle);
451 CFStringGetPascalString(pathCFStr, @pathStr, 255, CFStringGetSystemEncoding());
452 CFRelease(pathRef);
453 CFRelease(pathCFStr);
454 Result := pathStr;
455 end;
456 {$ENDIF}
458 procedure InitPath;
459 var i: Integer; rwdir, rodir: AnsiString; rwdirs, rodirs: SSArray;
461 procedure AddDir (var dirs: SSArray; append: AnsiString);
462 begin
463 SetLength(dirs, Length(dirs) + 1);
464 dirs[High(dirs)] := ExpandFileName(append)
465 end;
467 function IsSep (ch: Char): Boolean;
468 begin
469 {$IFDEF WINDOWS}
470 result := (ch = '/') or (ch = '\');
471 {$ELSE}
472 result := (ch = '/');
473 {$ENDIF}
474 end;
476 function OptimizePath (dir: AnsiString): AnsiString;
477 var i, len: Integer; s: AnsiString;
478 begin
479 i := 1; len := Length(dir); s := '';
480 while i <= len do
481 begin
482 if IsSep(dir[i]) then
483 begin
484 s := s + DirectorySeparator;
485 Inc(i);
486 while (i <= len) and IsSep(dir[i]) do Inc(i);
487 if (i <= len) and (dir[i] = '.') then
488 begin
489 if (i = len) or IsSep(dir[i + 1]) then
490 begin
491 Inc(i)
492 end
493 else if (i + 1 <= len) and (dir[i + 1] = '.') then
494 begin
495 if (i + 1 = len) or IsSep(dir[i + 2]) then
496 begin
497 s := e_UpperDir(s);
498 Inc(i, 2)
499 end
500 end
501 end
502 end
503 else
504 begin
505 s := s + dir[i];
506 Inc(i)
507 end
508 end;
509 result := s
510 end;
512 procedure OptimizeDirs (var dirs: SSArray);
513 var i, j, k: Integer;
514 begin
515 for i := 0 to High(dirs) do
516 dirs[i] := OptimizePath(dirs[i]);
517 // deduplicate
518 i := High(dirs);
519 while i >= 0 do
520 begin
521 j := 0;
522 while j < i do
523 begin
524 if dirs[j] = dirs[i] then
525 begin
526 for k := j + 1 to High(dirs) do
527 dirs[k - 1] := dirs[k];
528 Dec(i);
529 SetLength(dirs, High(dirs))
530 end
531 else
532 begin
533 Inc(j)
534 end
535 end;
536 Dec(i)
537 end
538 end;
540 procedure AddDef (var dirs: SSArray; base: SSArray; append: AnsiString);
541 var s: AnsiString;
542 begin
543 if Length(dirs) = 0 then
544 for s in base do
545 AddDir(dirs, e_CatPath(s, append));
546 OptimizeDirs(dirs)
547 end;
549 function GetDefaultRODirs (): SSArray;
550 {$IF DEFINED(UNIX) AND NOT DEFINED(DARWIN) AND NOT DEFINED(ANDROID)}
551 var home: AnsiString;
552 {$ENDIF}
553 {$IFDEF WINDOWS}
554 var appdata: AnsiString;
555 {$ENDIF}
556 {$IFDEF DARWIN}
557 var bundle, s: AnsiString; dirArr: NSArray; i: Integer;
558 {$ENDIF}
559 begin
560 result := nil;
561 {$IFDEF DARWIN}
562 bundle := GetBundlePath();
563 if ExtractFileExt(bundle) <> '.app' then
564 AddDir(result, binpath);
565 {$ELSE}
566 AddDir(result, binPath);
567 {$ENDIF}
568 if forceBinDir = false then
569 begin
570 {$IFDEF USE_SDL2}
571 AddDir(result, SDL_GetBasePath());
572 AddDir(result, SDL_GetPrefPath('', 'doom2df'));
573 {$ENDIF}
574 {$IFDEF WINDOWS}
575 appdata := GetEnvironmentVariable('APPDATA') + '\doom2df';
576 if appdata <> '' then
577 AddDir(result, appdata);
578 {$ENDIF}
579 {$IF DEFINED(UNIX) AND NOT DEFINED(DARWIN) AND NOT DEFINED(ANDROID)}
580 AddDir(result, '/usr/share/doom2df');
581 AddDir(result, '/usr/local/share/doom2df');
582 home := GetEnvironmentVariable('HOME');
583 if home <> '' then
584 AddDir(result, e_CatPath(home, '.doom2df'));
585 {$ENDIF}
586 {$IFDEF DARWIN}
587 bundle := GetBundlePath();
588 if bundle <> '' then
589 AddDir(result, e_CatPath(bundle, 'Contents/Resources'));
590 dirArr := NSSearchPathForDirectoriesInDomains(NSApplicationSupportDirectory, NSUserDomainMask, true);
591 for i := 0 to dirArr.count - 1 do
592 begin
593 s := NSStringToAnsiString(dirArr.objectAtIndex(i));
594 AddDir(result, e_CatPath(s, 'Doom 2D Forever'))
595 end;
596 {$ENDIF}
597 {$IF DEFINED(ANDROID) AND DEFINED(USE_SDL2)}
598 AddDir(result, SDL_AndroidGetInternalStoragePath());
599 if SDL_AndroidGetExternalStorageState() <> 0 then
600 AddDir(result, SDL_AndroidGetExternalStoragePath());
601 {$ENDIF}
602 end
603 end;
605 function GetDefaultRWDirs (): SSArray;
606 {$IF DEFINED(UNIX) AND NOT DEFINED(DARWIN) AND NOT DEFINED(ANDROID)}
607 var home: AnsiString;
608 {$ENDIF}
609 {$IFDEF WINDOWS}
610 var appdata: AnsiString;
611 {$ENDIF}
612 {$IFDEF DARWIN}
613 var bundle, s: AnsiString; dirArr: NSArray; i: Integer;
614 {$ENDIF}
615 begin
616 result := nil;
617 {$IFDEF DARWIN}
618 bundle := GetBundlePath();
619 if ExtractFileExt(bundle) <> '.app' then
620 AddDir(result, binPath);
621 {$ELSE}
622 AddDir(result, binPath);
623 {$ENDIF}
624 if forceBinDir = false then
625 begin
626 {$IFDEF USE_SDL2}
627 AddDir(result, SDL_GetPrefPath('', 'doom2df'));
628 {$ENDIF}
629 {$IFDEF WINDOWS}
630 appdata := GetEnvironmentVariable('APPDATA') + '\doom2df';
631 if appdata <> '' then
632 AddDir(result, appdata);
633 {$ENDIF}
634 {$IF DEFINED(UNIX) AND NOT DEFINED(DARWIN) AND NOT DEFINED(ANDROID)}
635 home := GetEnvironmentVariable('HOME');
636 if home <> '' then
637 AddDir(result, e_CatPath(home, '.doom2df'));
638 {$ENDIF}
639 {$IFDEF DARWIN}
640 dirArr := NSSearchPathForDirectoriesInDomains(NSApplicationSupportDirectory, NSUserDomainMask, true);
641 for i := 0 to dirArr.count - 1 do
642 begin
643 s := NSStringToAnsiString(dirArr.objectAtIndex(i));
644 AddDir(result, e_CatPath(s, 'Doom 2D Forever'))
645 end;
646 {$ENDIF}
647 {$IF DEFINED(ANDROID) AND DEFINED(USE_SDL2)}
648 if SDL_AndroidGetExternalStorageState() <> 0 then
649 AddDir(result, SDL_AndroidGetExternalStoragePath());
650 {$ENDIF}
651 end
652 end;
654 begin
655 forceBinDir := false;
656 binPath := GetBinaryPath();
658 i := 1;
659 while i < ParamCount do
660 begin
661 case ParamStr(i) of
662 '--like-windoze': forceBinDir := true;
663 '--rw-dir':
664 begin
665 Inc(i);
666 rwdir := ParamStr(i);
667 (* RW *)
668 AddDir(LogDirs, e_CatPath(rwdir, ''));
669 AddDir(SaveDirs, e_CatPath(rwdir, 'data'));
670 AddDir(CacheDirs, e_CatPath(rwdir, 'data/cache'));
671 AddDir(ConfigDirs, e_CatPath(rwdir, ''));
672 AddDir(MapDownloadDirs, e_CatPath(rwdir, 'maps/downloads'));
673 AddDir(WadDownloadDirs, e_CatPath(rwdir, 'wads/downloads'));
674 AddDir(ScreenshotDirs, e_CatPath(rwdir, 'screenshots'));
675 AddDir(StatsDirs, e_CatPath(rwdir, 'stats'));
676 (* RO *)
677 AddDir(DataDirs, e_CatPath(rwdir, 'data'));
678 AddDir(ModelDirs, e_CatPath(rwdir, 'data/models'));
679 AddDir(MegawadDirs, e_CatPath(rwdir, 'maps/megawads'));
680 AddDir(MapDirs, e_CatPath(rwdir, 'maps'));
681 AddDir(WadDirs, e_CatPath(rwdir, 'wads'));
682 end;
683 '--ro-dir':
684 begin
685 Inc(i);
686 rodir := ParamStr(i);
687 (* RO *)
688 AddDir(DataDirs, e_CatPath(rodir, 'data'));
689 AddDir(ModelDirs, e_CatPath(rodir, 'data/models'));
690 AddDir(MegawadDirs, e_CatPath(rodir, 'maps/megawads'));
691 AddDir(MapDirs, e_CatPath(rodir, 'maps'));
692 AddDir(WadDirs, e_CatPath(rodir, 'wads'));
693 end;
694 '--game-wad':
695 begin
696 Inc(i);
697 GameWADName := ParamStr(i);
698 end;
699 '--config':
700 begin
701 Inc(i);
702 gConfigScript := ParamStr(i);
703 end;
704 end;
705 Inc(i)
706 end;
708 // prefer bin dir if it writable and contains game.wad
709 if forceBinDir = false then
710 begin
711 if findDiskWad(binPath + 'data' + '/' + GameWADName) <> '' then
712 if e_CanCreateFilesAt(binPath) then
713 forceBinDir := true
714 end;
716 (* RO *)
717 rodirs := GetDefaultRODirs();
718 AddDef(DataDirs, rodirs, 'data');
719 AddDef(ModelDirs, rodirs, 'data/models');
720 AddDef(MegawadDirs, rodirs, 'maps/megawads');
721 AddDef(MapDirs, rodirs, 'maps');
722 AddDef(WadDirs, rodirs, 'wads');
724 (* RW *)
725 rwdirs := GetDefaultRWDirs();
726 AddDef(LogDirs, rwdirs, '');
727 AddDef(SaveDirs, rwdirs, 'data');
728 AddDef(CacheDirs, rwdirs, 'data/cache');
729 AddDef(ConfigDirs, rwdirs, '');
730 AddDef(MapDownloadDirs, rwdirs, 'maps/downloads');
731 AddDef(WadDownloadDirs, rwdirs, 'wads/downloads');
732 AddDef(ScreenshotDirs, rwdirs, 'screenshots');
733 AddDef(StatsDirs, rwdirs, 'stats');
735 for i := 0 to High(MapDirs) do
736 AddDir(AllMapDirs, MapDirs[i]);
737 for i := 0 to High(MegawadDirs) do
738 AddDir(AllMapDirs, MegawadDirs[i]);
739 OptimizeDirs(AllMapDirs);
741 // HACK: ensure the screenshots folder also has a stats subfolder in it
742 rwdir := e_GetWriteableDir(ScreenshotDirs, false);
743 if rwdir <> '' then CreateDir(rwdir + '/stats');
744 end;
746 procedure EntryParams;
747 var i: Integer;
748 begin
749 i := 1;
750 while i <= ParamCount do
751 begin
752 case ParamStr(i) of
753 '--gdb': noct := true;
754 '--log', '--con-stdout': conbufDumpToStdOut := true;
755 '--safe-log': e_SetSafeSlowLog(true);
756 '--log-file':
757 if i + 1 <= ParamCount then
758 begin
759 Inc(i);
760 LogFileName := ParamStr(i)
761 end;
762 '--no-fbo': glRenderToFBO := false;
763 end;
764 Inc(i)
765 end
766 end;
768 procedure InitLog;
769 var rwdir: AnsiString;
770 begin
771 if LogFileName = '' then
772 begin
773 rwdir := e_GetWriteableDir(LogDirs, false);
774 if rwdir <> '' then
775 begin
776 {$IFDEF HEADLESS}
777 LogFileName := e_CatPath(rwdir, 'Doom2DF_H.log');
778 {$ELSE}
779 LogFileName := e_CatPath(rwdir, 'Doom2DF.log');
780 {$ENDIF}
781 end
782 end;
783 if LogFileName <> '' then
784 e_InitLog(LogFileName, TWriteMode.WM_NEWFILE);
785 e_InitWritelnDriver
786 end;
788 procedure InitPrep;
789 begin
790 e_WriteLog('Doom 2D: Forever version ' + GAME_VERSION + ' proto ' + IntToStr(NET_PROTOCOL_VER), TMsgType.Notify);
791 e_WriteLog('Build arch: ' + g_GetBuildArch(), TMsgType.Notify);
792 e_WriteLog('Build date: ' + GAME_BUILDDATE + ' ' + GAME_BUILDTIME, TMsgType.Notify);
793 e_WriteLog('Build hash: ' + g_GetBuildHash(), TMsgType.Notify);
794 e_WriteLog('Build by: ' + g_GetBuilderName(), TMsgType.Notify);
796 e_LogWritefln('Force bin dir: %s', [forceBinDir], TMsgType.Notify);
797 e_LogWritefln('BINARY PATH: [%s]', [binPath], TMsgType.Notify);
799 PrintDirs('DataDirs', DataDirs);
800 PrintDirs('ModelDirs', ModelDirs);
801 PrintDirs('MegawadDirs', MegawadDirs);
802 PrintDirs('MapDirs', MapDirs);
803 PrintDirs('WadDirs', WadDirs);
805 PrintDirs('LogDirs', LogDirs);
806 PrintDirs('SaveDirs', SaveDirs);
807 PrintDirs('CacheDirs', CacheDirs);
808 PrintDirs('ConfigDirs', ConfigDirs);
809 PrintDirs('ScreenshotDirs', ScreenshotDirs);
810 PrintDirs('StatsDirs', StatsDirs);
811 PrintDirs('MapDownloadDirs', MapDownloadDirs);
812 PrintDirs('WadDownloadDirs', WadDownloadDirs);
814 {$IFDEF HEADLESS}
815 {$IFDEF USE_SDLMIXER}
816 NoSound := False; // hope env has set SDL_AUDIODRIVER to dummy
817 {$ELSE}
818 NoSound := True; // FMOD backend will sort it out
819 {$ENDIF}
820 {$ELSE}
821 NoSound := False;
822 {$ENDIF}
824 GameWAD := e_FindWad(DataDirs, GameWADName);
825 if GameWad = '' then
826 begin
827 e_WriteLog('WAD ' + GameWADName + ' not found in data directories.', TMsgType.Fatal);
828 {$IF DEFINED(USE_SDL2) AND NOT DEFINED(HEADLESS)}
829 if forceBinDir = false then
830 SDL_ShowSimpleMessageBox(
831 SDL_MESSAGEBOX_ERROR,
832 'Doom 2D Forever',
833 PChar('WAD ' + GameWADName + ' not found in data directories.'),
834 nil
835 );
836 {$ENDIF}
837 e_DeinitLog;
838 Halt(1);
839 end
840 end;
842 {$IFDEF ENABLE_HOLMES}
843 procedure InitHolmes;
844 var flexloaded: Boolean;
845 begin
846 flexloaded := true;
847 if not fuiAddWad('flexui.wad') then
848 begin
849 if not fuiAddWad('./data/flexui.wad') then fuiAddWad('./flexui.wad');
850 end;
851 try
852 fuiGfxLoadFont('win8', 'flexui/fonts/win8.fuifont');
853 fuiGfxLoadFont('win14', 'flexui/fonts/win14.fuifont');
854 fuiGfxLoadFont('win16', 'flexui/fonts/win16.fuifont');
855 fuiGfxLoadFont('dos8', 'flexui/fonts/dos8.fuifont');
856 fuiGfxLoadFont('msx6', 'flexui/fonts/msx6.fuifont');
857 except on e: Exception do
858 begin
859 writeln('ERROR loading FlexUI fonts');
860 flexloaded := false;
861 //raise;
862 end;
863 else
864 begin
865 flexloaded := false;
866 //raise;
867 end;
868 end;
869 if flexloaded then
870 begin
871 try
872 e_LogWriteln('FlexUI: loading stylesheet...');
873 uiLoadStyles('flexui/widgets.wgs');
874 except on e: TParserException do
875 begin
876 writeln('ERROR at (', e.tokLine, ',', e.tokCol, '): ', e.message);
877 //raise;
878 flexloaded := false;
879 end;
880 else
881 begin
882 //raise;
883 flexloaded := false;
884 end;
885 end;
886 end;
887 g_holmes_imfunctional := not flexloaded;
888 if not g_holmes_imfunctional then
889 begin
890 uiInitialize();
891 uiContext.font := 'win14';
892 end;
893 if assigned(oglInitCB) then oglInitCB;
894 end;
896 procedure FreeHolmes;
897 begin
898 if assigned(oglDeinitCB) then
899 oglDeinitCB
900 end;
901 {$ENDIF}
903 procedure InitSound;
904 {$IFDEF USE_SDLMIXER}
905 var timiditycfg: AnsiString;
906 var oldcwd, newcwd: RawByteString;
907 {$ENDIF}
908 begin
909 if NoSound = false then
910 begin
911 e_WriteLog('Initializing sound system', TMsgType.Notify);
912 {$IFDEF USE_SDLMIXER}
913 newcwd := '';
914 if UseNativeMusic then
915 SetEnvVar('SDL_NATIVE_MUSIC', '1');
916 timiditycfg := GetEnvironmentVariable('TIMIDITY_CFG');
917 if timiditycfg = '' then
918 begin
919 timiditycfg := 'timidity.cfg';
920 if e_FindResource(ConfigDirs, timiditycfg) OR e_FindResource(DataDirs, timiditycfg) then
921 begin
922 timiditycfg := ExpandFileName(timiditycfg);
923 newcwd := ExtractFileDir(timiditycfg);
924 SetEnvVar('TIMIDITY_CFG', timiditycfg);
925 end
926 else
927 timiditycfg := '';
928 end;
929 e_LogWritefln('TIMIDITY_CFG = "%s"', [timiditycfg]);
930 e_LogWritefln('SDL_NATIVE_MUSIC = "%s"', [GetEnvironmentVariable('SDL_NATIVE_MUSIC')]);
931 {$ENDIF}
932 e_InitSoundSystem(NoSound);
933 {$IFDEF USE_SDLMIXER}
934 if e_TimidityDecoder and (newcwd <> '') then
935 begin
936 (* HACK: Set CWD to load GUS patches relatively to cfg file. *)
937 (* CWD not restored after sound init because timidity *)
938 (* store relative pathes internally and load patches *)
939 (* later. I hope game never relies on CWD. *)
940 oldcwd := '';
941 GetDir(0, oldcwd);
942 ChDir(newcwd);
943 e_logwritefln('WARNING: USED TIMIDITY CONFIG HACK, CWD SWITCHED "%s" -> "%s"', [oldcwd, newcwd]);
944 end;
945 {$ENDIF}
946 end;
947 end;
949 procedure ScreenResize (w, h: Integer);
950 begin
951 r_Render_Resize(w, h);
952 {$IFDEF ENABLE_HOLMES}
953 fuiScrWdt := w;
954 fuiScrHgt := h;
955 {$ENDIF}
956 g_Game_SetupScreenSize;
957 {$IFNDEF ANDROID}
958 (* This will fix menu reset on keyboard showing *)
959 g_Menu_Reset;
960 {$ENDIF}
961 //g_Game_ClearLoading;
962 {$IFDEF ENABLE_HOLMES}
963 if assigned(oglInitCB) then oglInitCB;
964 {$ENDIF}
965 end;
967 procedure Startup;
968 begin
969 Randomize;
970 InitPath;
971 InitLog;
972 InitPrep;
973 e_Input_Initialize;
974 InitSound;
975 sys_Init;
976 sys_CharPress := @CharPress; (* install hook *)
977 sys_ScreenResize := @ScreenResize; (* install hook *)
978 g_Options_SetDefault;
979 g_Options_SetDefaultVideo;
980 g_Console_Initialize;
981 // TODO move load configs here
982 g_Language_Set(gLanguage);
983 r_Render_Initialize;
984 g_Touch_Init;
985 DebugOptions;
986 g_Net_InitLowLevel;
987 // TODO init serverlist
988 {$IFDEF ENABLE_HOLMES}
989 InitHolmes;
990 {$ENDIF}
991 r_Render_Load;
992 g_Game_Init;
993 {$IFNDEF HEADLESS}
994 g_Menu_Init;
995 g_GUI_Init;
996 {$ENDIF}
997 g_Game_Process_Params;
998 // TODO reload GAME textures
999 g_Console_Init; // welcome message
1000 {$IFNDEF HEADLESS}
1001 if (not gGameOn) and gAskLanguage then
1002 g_Menu_AskLanguage;
1003 {$ENDIF}
1004 Time_Old := GetTickCount64();
1005 while not ProcessMessage() do begin end;
1006 g_Console_WriteGameConfig;
1007 {$IFNDEF HEADLESS}
1008 g_GUI_Destroy;
1009 g_Menu_Free;
1010 {$ENDIF}
1011 r_Render_Free;
1012 {$IFDEF ENABLE_HOLMES}
1013 FreeHolmes;
1014 {$ENDIF}
1015 g_Net_Slist_ShutdownAll;
1016 g_Net_DeinitLowLevel;
1017 (* g_Touch_Finalize; *)
1018 r_Render_Finalize;
1019 sys_Final;
1020 g_Console_Finalize;
1021 e_ReleaseSoundSystem;
1022 e_Input_Finalize;
1023 e_WriteLog('Shutdown with no errors.', TMsgType.Notify)
1024 end;
1026 procedure InitCVars;
1027 begin
1028 {$IFDEF USE_SDLMIXER}
1029 conRegVar('sdl_native_music', @UseNativeMusic, 'use native midi music output when possible', 'use native midi');
1030 {$IFDEF DARWIN}
1031 UseNativeMusic := true; (* OSX have a good midi support, so why not? *)
1032 {$ELSE}
1033 UseNativeMusic := false;
1034 {$ENDIF}
1035 {$ENDIF}
1036 end;
1038 procedure EntryPoint;
1039 begin
1040 SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]); //k8: fuck off, that's why
1041 InitCVars;
1042 EntryParams;
1043 e_Log_Initialize;
1044 {$IFDEF HEADLESS}
1045 conbufDumpToStdOut := true;
1046 {$ENDIF}
1047 if noct then
1048 Startup
1049 else
1050 try
1051 Startup
1052 except on e: Exception do
1053 e_WriteStackTrace(e.message)
1054 else
1055 e_WriteStackTrace('FATAL ERROR')
1056 end;
1057 e_Log_Finalize
1058 end;
1060 {$IFDEF ANDROID}
1061 function SDL_main (argc: CInt; argv: PPChar): CInt; cdecl;
1062 begin
1063 {$IFDEF ANDROID}
1064 System.argc := argc;
1065 System.argv := argv;
1066 {$ENDIF}
1067 EntryPoint;
1068 result := 0
1069 end;
1071 function JNI_OnLoad (vm: PJavaVM; reserved: pointer): JInt; cdecl;
1072 begin
1073 result:= JNI_VERSION_1_6;
1074 end;
1076 procedure JNI_OnUnload(vm: PJavaVM; reserved: pointer); cdecl;
1077 begin
1078 end;
1080 // DONT REMOVE JNI FUNCTIONS. SPECIAL HANDLING BY FPC.
1081 exports SDL_main name 'SDL_main';
1082 exports JNI_OnLoad name 'JNI_OnLoad';
1083 exports JNI_OnUnload name 'JNI_Unload';
1084 {$ELSE}
1085 begin
1086 EntryPoint
1087 {$ENDIF}
1089 end.