1 (*
2  * Hedgewars, a free turn based strategy game
3  * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
4  *
5  * This program is free software; you can redistribute it and/or modify
6  * it under the terms of the GNU General Public License as published by
7  * the Free Software Foundation; version 2 of the License
8  *
9  * This program is distributed in the hope that it will be useful,
10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12  * GNU General Public License for more details.
13  *
14  * You should have received a copy of the GNU General Public License
15  * along with this program; if not, write to the Free Software
16  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
17  *)
18 
19 {$INCLUDE "options.inc"}
20 
21 {$IFDEF WINDOWS}
22 {$R res/hwengine.rc}
23 {$ENDIF}
24 
25 {$IFDEF HWLIBRARY}
26 unit hwengine;
27 interface
28 {$ELSE}
29 program hwengine;
30 {$ENDIF}
31 
32 uses {$IFDEF IPHONEOS}cmem, {$ENDIF} SDLh, uMisc, uConsole, uGame, uConsts, uLand, uAmmos, uVisualGears, uGears, uStore, uWorld, uInputHandler
33      , uSound, uScript, uTeams, uStats, uIO, uLocale, uChat, uAI, uAIMisc, uAILandMarks, uLandTexture, uCollisions
34      , SysUtils, uTypes, uVariables, uCommands, uUtils, uCaptions, uDebug, uCommandHandlers, uLandPainted
35      , uPhysFSLayer, uCursor, uRandom, ArgParsers, uVisualGearsHandlers, uTextures, uRender
36      {$IFDEF USE_VIDEO_RECORDING}, uVideoRec {$ENDIF}
37      {$IFDEF USE_TOUCH_INTERFACE}, uTouch {$ENDIF}
38      {$IFDEF ANDROID}, GLUnit{$ENDIF}
39      {$IFDEF UNIX}, clocale{$ENDIF}
40      {$IFDEF WINDOWS}, dynlibs{$ENDIF}
41      ;
42 
43 {$IFDEF HWLIBRARY}
RunEnginenull44 function RunEngine(argc: LongInt; argv: PPChar): LongInt; cdecl; export;
45 
46 procedure preInitEverything();
47 procedure initEverything(complete:boolean);
48 procedure freeEverything(complete:boolean);
49 {$IFNDEF PAS2C}
50 procedure catchUnhandledException(Obj: TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer);
51 {$ENDIF}
52 
53 implementation
54 {$ELSE}
55 procedure preInitEverything(); forward;
56 procedure initEverything(complete:boolean); forward;
57 procedure freeEverything(complete:boolean); forward;
58 {$IFNDEF PAS2C}
59 procedure catchUnhandledException(Obj: TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer); forward;
60 {$ENDIF}
61 {$ENDIF}
62 
63 {$IFDEF WINDOWS}
aluenull64 type TSetProcessDpiAwareness = function(value: Integer): Integer; stdcall;
65 var SetProcessDpiAwareness: TSetProcessDpiAwareness;
66 var ShcoreLibHandle: TLibHandle;
67 {$ENDIF}
68 
69 ///////////////////////////////////////////////////////////////////////////////
DoTimernull70 function DoTimer(Lag: LongInt): boolean;
71 var s: shortstring;
72     t: LongWord;
73 begin
74     DoTimer:= false;
75     inc(RealTicks, Lag);
76 
77     case GameState of
78         gsLandGen:
79             begin
80             GenMap;
81             SetLandTexture;
82             UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT, false);
83             setAILandMarks;
84             GameState:= gsStart;
85             end;
86         gsStart:
87             begin
88             SetDefaultBinds;
89             if HasBorder then
90                 DisableSomeWeapons;
91             // wave "clouds" on underwater theme look weird w/ weSea, esp the blended bottom portion
92             if (WorldEdge <> weSea) or (Theme <> 'Underwater') then
93                 AddClouds;
94             AddFlakes;
95             SetRandomSeed(cSeed, false);
96             StoreLoad(false);
97             ParseCommand('sendlanddigest', true); // extending land digest to all synced pixels (anything that could modify land)
98             if not allOK then exit;
99             AssignHHCoords;
100             AddMiscGears;
101             InitWorld;
102             ResetKbd;
103             if GameType = gmtSave then
104                 SetSound(false);
105             FinishProgress;
106             PlayMusic;
107             InitZoom(zoom);
108             ScriptCall('onGameStart');
109             RandomizeHHAnim;
110             for t:= 0 to Pred(TeamsCount) do
111                 with TeamsArray[t]^ do
112                     MaxTeamHealth:= TeamHealth;
113             RecountAllTeamsHealth;
114             GameState:= gsGame;
115             end;
116         gsConfirm, gsGame:
117             begin
118             // disable screenshot flash effect when about to make another screenshot
119             if flagMakeCapture and (ScreenFade = sfFromWhite) then
120                 ScreenFade:= sfNone;
121             if not cOnlyStats then
122                 // never place between ProcessKbd and DoGameTick - bugs due to /put cmd and isCursorVisible
123                 DrawWorld(Lag);
124             DoGameTick(Lag);
125             if not cOnlyStats then ProcessVisualGears(Lag);
126             end;
127         gsExit:
128             begin
129             DoTimer:= true;
130             end;
131         gsSuspend:
132             exit(false);
133             end;
134 
135     if not cOnlyStats then SwapBuffers;
136 
137 {$IFDEF USE_VIDEO_RECORDING}
138     if flagPrerecording then
139         SaveCameraPosition;
140 {$ENDIF}
141 
142     if flagMakeCapture then
143         begin
144         flagMakeCapture:= false;
145         if flagDumpLand then
146              s:= '/Screenshots/mapdump_'
147         else s:= '/Screenshots/hw_';
148         {$IFDEF PAS2C}
149         s:= s + inttostr(GameTicks);
150         {$ELSE}
151         s:= s + FormatDateTime('YYYY-MM-DD_HH-mm-ss', Now()) + inttostr(GameTicks);
152         {$ENDIF}
153 
154         // flash
155         playSound(sndShutter);
156         ScreenFade:= sfFromWhite;
157         ScreenFadeValue:= sfMax;
158         ScreenFadeSpeed:= 5;
159 
160         if (not flagDumpLand and MakeScreenshot(s, 1, 0)) or
161            (flagDumpLand and MakeScreenshot(s, 1, 1) and ((cReducedQuality and rqBlurryLand <> 0) or MakeScreenshot(s, 1, 2))) then
162             WriteLnToConsole('Screenshot saved: ' + s)
163         else
164             begin
165             WriteLnToConsole('Screenshot failed.');
166             AddChatString(#5 + 'screen capture failed (lack of memory or write permissions)');
167             end
168         end;
169 end;
170 
171 ///////////////////////////////////////////////////////////////////////////////
172 procedure MainLoop;
173 var event: TSDL_Event;
174     PrevTime, CurrTime: LongWord;
175     isTerminated: boolean;
176     previousGameState: TGameState;
177     wheelEvent: boolean;
178 begin
179     previousGameState:= gsStart;
180     isTerminated:= false;
181     PrevTime:= SDL_GetTicks;
182     while (not isTerminated) and allOK do
183     begin
184         wheelEvent:= false;
185         SDL_PumpEvents();
186 
187         while SDL_PeepEvents(@event, 1, SDL_GETEVENT, SDL_FIRSTEVENT, SDL_LASTEVENT) > 0 do
188         begin
189             case event.type_ of
190                 SDL_KEYDOWN:
191                     if isInChatMode then
192                         begin
193                     // sdl on iphone supports only ashii keyboards and the unicode field is deprecated in sdl 1.3
194                         KeyPressChat(event.key.keysym);
195                         end
196                     else
197                         if GameState >= gsGame then ProcessKey(event.key);
198                 SDL_KEYUP:
199                     if (not isInChatMode) and (GameState >= gsGame) then
200                         ProcessKey(event.key);
201 
202                 SDL_TEXTINPUT: if isInChatMode then uChat.TextInput(event.text);
203 
204                 SDL_WINDOWEVENT:
205                     begin
206                     case event.window.event of
207                         SDL_WINDOWEVENT_FOCUS_GAINED:
208                                 begin
209                                 cHasFocus:= true;
210                                 onFocusStateChanged();
211                                 end;
212                         SDL_WINDOWEVENT_FOCUS_LOST:
213                                 begin
214                                 cHasFocus:= false;
215                                 onFocusStateChanged();
216                                 end;
217 {$IFDEF MOBILE}
218 (* Suspend game if minimized on mobile.
219 NOTE: Mobile doesn't support online multiplayer yet, so it's not a problem.
220 BUT: This section WILL become a bug when online multiplayer is added to
221 Hedgewars and needs to be rethought. This is because it will cause the
222 game to freeze if one online player minimizes Hedgewars. *)
223                         SDL_WINDOWEVENT_MINIMIZED:
224                                 begin
225                                 previousGameState:= GameState;
226                                 GameState:= gsSuspend;
227                                 end;
228 {$ENDIF}
229                         SDL_WINDOWEVENT_RESTORED:
230                                 begin
231                                 if GameState = gsSuspend then
232                                     GameState:= previousGameState;
233                                 cWindowedMaximized:= false;
234 {$IFDEF ANDROID}
235                                 //This call is used to reinitialize the glcontext and reload the textures
236                                 ParseCommand('fullscr '+intToStr(LongInt(cFullScreen)), true);
237 {$ENDIF}
238                                 end;
239                         SDL_WINDOWEVENT_MAXIMIZED:
240                                 cWindowedMaximized:= true;
241                         SDL_WINDOWEVENT_RESIZED:
242                                 begin
243                                 cNewScreenWidth:= max(2 * (event.window.data1 div 2), cMinScreenWidth);
244                                 cNewScreenHeight:= max(2 * (event.window.data2 div 2), cMinScreenHeight);
245                                 cScreenResizeDelay:= RealTicks + 500{$IFDEF IPHONEOS}div 2{$ENDIF};
246                                 end;
247                         end; // case closed
248                     end;
249 
250 {$IFDEF USE_TOUCH_INTERFACE}
251                 SDL_FINGERMOTION:
252                     onTouchMotion(event.tfinger.x, event.tfinger.y, event.tfinger.dx, event.tfinger.dy, event.tfinger.fingerId);
253 
254                 SDL_FINGERDOWN:
255                     onTouchDown(event.tfinger.x, event.tfinger.y, event.tfinger.fingerId);
256 
257                 SDL_FINGERUP:
258                     onTouchUp(event.tfinger.x, event.tfinger.y, event.tfinger.fingerId);
259 {$ELSE}
260                 SDL_MOUSEMOTION:
261                     ProcessMouseMotion(event.motion.xrel, event.motion.yrel);
262 
263                 SDL_MOUSEBUTTONDOWN:
264                     if GameState = gsConfirm then
265                         ParseCommand('quit', true)
266                     else
267                         if (GameState >= gsGame) then ProcessMouseButton(event.button, true);
268 
269                 SDL_MOUSEBUTTONUP:
270                     if (GameState >= gsGame) then ProcessMouseButton(event.button, false);
271 
272                 SDL_MOUSEWHEEL:
273                     begin
274                     wheelEvent:= true;
275                     ProcessMouseWheel(event.wheel.y);
276                     end;
277 {$ENDIF}
278 
279                 SDL_JOYAXISMOTION:
280                     ControllerAxisEvent(event.jaxis.which, event.jaxis.axis, event.jaxis.value);
281                 SDL_JOYHATMOTION:
282                     ControllerHatEvent(event.jhat.which, event.jhat.hat, event.jhat.value);
283                 SDL_JOYBUTTONDOWN:
284                     ControllerButtonEvent(event.jbutton.which, event.jbutton.button, true);
285                 SDL_JOYBUTTONUP:
286                     ControllerButtonEvent(event.jbutton.which, event.jbutton.button, false);
287                 SDL_QUITEV:
288                     isTerminated:= true
289             end; //end case event.type_ of
290         end; //end while SDL_PollEvent(@event) <> 0 do
291 
292         if (not wheelEvent) then
293             ResetMouseWheel();
294 
295         if (CursorMovementX <> 0) or (CursorMovementY <> 0) then
296             handlePositionUpdate(CursorMovementX, CursorMovementY);
297 
298         if (cScreenResizeDelay <> 0) and (cScreenResizeDelay < RealTicks) and
299            ((cNewScreenWidth <> cScreenWidth) or (cNewScreenHeight <> cScreenHeight)) then
300         begin
301             cScreenResizeDelay:= 0;
302             cWindowedWidth:= cNewScreenWidth;
303             cWindowedHeight:= cNewScreenHeight;
304             cScreenWidth:= cWindowedWidth;
305             cScreenHeight:= cWindowedHeight;
306 
307             ParseCommand('fullscr '+intToStr(LongInt(cFullScreen)), true);
308             if cWindowedMaximized then
309                 WriteLnToConsole('window resize: ' + IntToStr(cScreenWidth) + ' x ' + IntToStr(cScreenHeight) + ' (maximized)')
310             else
311                 WriteLnToConsole('window resize: ' + IntToStr(cScreenWidth) + ' x ' + IntToStr(cScreenHeight));
312             ScriptOnScreenResize();
313             InitCameraBorders();
314             InitTouchInterface();
315             InitZoom(zoomValue);
316             if cWindowedMaximized then
317                 SendIPC('W' + IntToStr(cScreenWidth) + 'x' + IntToStr(cScreenHeight) + 'M')
318             else
319                 SendIPC('W' + IntToStr(cScreenWidth) + 'x' + IntToStr(cScreenHeight));
320         end;
321 
322         CurrTime:= SDL_GetTicks();
323         if PrevTime + longword(cTimerInterval) <= CurrTime then
324         begin
325             isTerminated:= isTerminated or DoTimer(CurrTime - PrevTime);
326             PrevTime:= CurrTime;
327         end
328         else SDL_Delay(1);
329         IPCCheckSock();
330 
331     end;
332 end;
333 
334 {$IFDEF USE_VIDEO_RECORDING}
335 procedure RecorderMainLoop;
336 var oldGameTicks, oldRealTicks, newGameTicks, newRealTicks: LongInt;
337 begin
338     if not BeginVideoRecording() then
339         exit;
340     DoTimer(0); // gsLandGen -> gsStart
341     DoTimer(0); // gsStart -> gsGame
342 
343     newGameTicks:= 0;
344     newRealTicks:= 0;
345 
346     if not LoadNextCameraPosition(newRealTicks, newGameTicks) then
347         exit;
348     fastScrolling:= true;
349     DoGameTick(newGameTicks);
350     fastScrolling:= false;
351     oldRealTicks:= 0;
352     oldGameTicks:= newGameTicks;
353 
354     while LoadNextCameraPosition(newRealTicks, newGameTicks) do
355     begin
356         IPCCheckSock();
357         RealTicks:= newRealTicks;
358         DoGameTick(newGameTicks - oldGameTicks);
359         if GameState = gsExit then
360             break;
361         ProcessVisualGears(newRealTicks - oldRealTicks);
362         DrawWorld(newRealTicks - oldRealTicks);
363         EncodeFrame();
364         oldRealTicks:= newRealTicks;
365         oldGameTicks:= newGameTicks;
366     end;
367     StopVideoRecording();
368 end;
369 {$ENDIF}
370 
371 ///////////////////////////////////////////////////////////////////////////////
372 procedure GameRoutine;
373 var s: shortstring;
374     i: LongInt;
375 begin
376 {$IFDEF PAS2C}
377     AddFileLog('Generated using pas2c');
378 {$ENDIF}
379     WriteLnToConsole('Hedgewars engine ' + cVersionString + '-r' + cRevisionString +
380                      ' (' + cHashString + ') with protocol #' + inttostr(cNetProtoVersion));
381     AddFileLog('Prefix: "' + shortstring(PathPrefix) +'"');
382     AddFileLog('UserPrefix: "' + shortstring(UserPathPrefix) +'"');
383 
384     for i:= 0 to ParamCount do
385         AddFileLog(inttostr(i) + ': ' + ParamStr(i));
386 
387     WriteToConsole('Init SDL... ');
388     if not cOnlyStats then SDLCheck(SDL_Init(SDL_INIT_VIDEO or SDL_INIT_NOPARACHUTE) >= 0, 'SDL_Init', true);
389     WriteLnToConsole(msgOK);
390     if not cOnlyStats then
391         begin
392         WriteToConsole('Init SDL_ttf... ');
393         SDLCheck(TTF_Init() <> -1, 'TTF_Init', true);
394         WriteLnToConsole(msgOK);
395         end;
396 
397     if not allOK then exit;
398 
399     SDL_ShowCursor(SDL_DISABLE);
400 
401 {$IFDEF USE_VIDEO_RECORDING}
402     if GameType = gmtRecord then
403         InitOffscreenOpenGL()
404     else
405 {$ENDIF}
406         begin
407         // show main window
408         if cFullScreen then
409             ParseCommand('fullscr 1', true)
410         else
411             ParseCommand('fullscr 0', true);
412         end;
413 
414     ControllerInit(); // has to happen before InitKbdKeyTable to map keys
415     InitKbdKeyTable();
416     if not allOK then exit;
417 
418     LoadLocale(cPathz[ptLocale] + '/en.txt');  // Do an initial load with english
419     if cLanguageFName <> 'en.txt' then
420         begin
421         // Try two letter locale first before trying specific locale overrides
422         if (Length(cLanguage) > 3) and (Copy(cLanguage, 1, 2) <> 'en') then
423             begin
424             LoadLocale(cPathz[ptLocale] + '/' + Copy(cLanguage, 1, 2) + '.txt')
425             end;
426         LoadLocale(cPathz[ptLocale] + '/' + cLanguageFName)
427         end
428     else cLanguage := 'en';
429 
430     if not allOK then exit;
431     WriteLnToConsole(msgGettingConfig);
432 
433     LoadFonts();
434     AddProgress();
435     LoadDefaultClanColors(cPathz[ptConfig] + '/settings.ini');
436 
437     if cTestLua then
438         begin
439         ParseCommand('script ' + cScriptName, true);
440         end
441     else
442         begin
443         if recordFileName = '' then
444             begin
445             InitIPC;
446             SendIPCAndWaitReply(_S'C');        // ask for game config
447             end
448         else
449             LoadRecordFromFile(recordFileName);
450         end;
451 
452     if not allOK then exit;
453     ScriptOnGameInit;
454     s:= 'eproto ' + inttostr(cNetProtoVersion);
455     SendIPCRaw(@s[0], Length(s) + 1); // send proto version
456 
457     InitTeams();
458     AssignStores();
459 
460     if GameType = gmtRecord then
461         SetSound(false);
462 
463     InitSound();
464 
465     isDeveloperMode:= false;
466     if checkFails(InitStepsFlags = cifAllInited, 'Some parameters not set (flags = ' + inttostr(InitStepsFlags) + ')', true) then exit;
467     if not allOK then exit;
468 
469 {$IFDEF USE_VIDEO_RECORDING}
470     if GameType = gmtRecord then
471     begin
472         RecorderMainLoop();
473         exit;
474     end;
475 {$ENDIF}
476 
477     MainLoop;
478 end;
479 
480 procedure Game;
481 begin
482     initEverything(true);
483     GameRoutine;
484     // clean up all the memory allocated
485     freeEverything(true);
486 end;
487 ///////////////////////////////////////////////////////////////////////////////
488 // preInitEverything - init variables that are going to be ovewritten by arguments
489 // initEverything - init variables only. Should be coupled by below
490 // freeEverything - free above. Pay attention to the init/free order!
491 procedure preInitEverything;
492 begin
493     allOK:= true;
494     Randomize();
495 
496     uVariables.preInitModule;
497     uSound.preInitModule;
498 end;
499 
500 procedure initEverything (complete:boolean);
501 begin
502     PathPrefix:= PathPrefix + #0;
503     UserPathPrefix:= UserPathPrefix + #0;
504     uPhysFSLayer.initModule(@PathPrefix[1], @UserPathPrefix[1]);
505     PathPrefix:= copy(PathPrefix, 1, length(PathPrefix) - 1);
506     UserPathPrefix:= copy(UserPathPrefix, 1, length(UserPathPrefix) - 1);
507 
508     uUtils.initModule(complete);    // opens the debug file, must be the first
509     uVariables.initModule;          // inits all global variables
510     uCommands.initModule;           // helps below
511     uCommandHandlers.initModule;    // registers all messages from frontend
512 
513     uLand.initModule;               // computes land
514     uLandPainted.initModule;        // computes drawn land
515     uIO.initModule;                 // sets up sockets
516 
517     uScript.initModule;
518 
519     if complete then
520     begin
521         uTextures.initModule;
522 {$IFDEF ANDROID}GLUnit.initModule;{$ENDIF}
523 {$IFDEF USE_TOUCH_INTERFACE}uTouch.initModule;{$ENDIF}
524 {$IFDEF USE_VIDEO_RECORDING}uVideoRec.initModule;{$ENDIF}
525         uAI.initModule;
526         uAIMisc.initModule;
527         uAILandMarks.initModule;    //stub
528         uAmmos.initModule;
529         uCaptions.initModule;
530 
531         uChat.initModule;
532         uCollisions.initModule;
533         uGears.initModule;
534         uInputHandler.initModule;
535         uMisc.initModule;
536         uLandTexture.initModule;    //stub
537         uSound.initModule;
538         uStats.initModule;
539         uStore.initModule;
540         uRender.initModule;
541         uTeams.initModule;
542         uVisualGears.initModule;
543         uVisualGearsHandlers.initModule;
544         uWorld.initModule;
545     end;
546 end;
547 
548 procedure freeEverything (complete:boolean);
549 begin
550     if complete then
551         begin
552         WriteLnToConsole('Freeing resources...');
553         uAI.freeModule;             // AI things need to be freed first
554         uAIMisc.freeModule;         //stub
555         uAILandMarks.freeModule;
556         uCaptions.freeModule;
557         uWorld.freeModule;
558         uVisualGears.freeModule;
559         uTeams.freeModule;
560         uInputHandler.freeModule;
561         uStats.freeModule;          //stub
562         uSound.freeModule;
563         uMisc.freeModule;
564         uLandTexture.freeModule;
565         uGears.freeModule;
566         uCollisions.freeModule;     //stub
567         uChat.freeModule;
568         uAmmos.freeModule;
569         uRender.freeModule;
570         uStore.freeModule;          // closes SDL
571 {$IFDEF USE_VIDEO_RECORDING}uVideoRec.freeModule;{$ENDIF}
572 {$IFDEF USE_TOUCH_INTERFACE}uTouch.freeModule;{$ENDIF}  //stub
573 {$IFDEF ANDROID}GLUnit.freeModule;{$ENDIF}
574         uTextures.freeModule;
575         SDL_GL_DeleteContext(SDLGLcontext);
576         SDL_DestroyWindow(SDLwindow);
577         SDL_Quit()
578         end;
579 
580     uIO.freeModule;
581     uLand.freeModule;
582     uLandPainted.freeModule;
583 
584     uCommandHandlers.freeModule;
585     uCommands.freeModule;
586     uVariables.freeModule;
587     uUtils.freeModule;              // closes debug file
588     uPhysFSLayer.freeModule;
589     uScript.freeModule;
590 end;
591 
592 ///////////////////////////////////////////////////////////////////////////////
593 procedure GenLandPreview;
594 {$IFDEF MOBILE}
595 var Preview: TPreview;
596 {$ELSE}
597 var Preview: TPreviewAlpha;
598 {$ENDIF}
599 begin
600     initEverything(false);
601 
602     InitIPC;
603     if allOK then
604     begin
605         IPCWaitPongEvent;
606         if checkFails(InitStepsFlags = cifRandomize, 'Some parameters not set (flags = ' + inttostr(InitStepsFlags) + ')', true) then exit;
607 
608         ScriptOnPreviewInit;
609     {$IFDEF MOBILE}
610         GenPreview(Preview);
611     {$ELSE}
612         GenPreviewAlpha(Preview);
613     {$ENDIF}
614         WriteLnToConsole('Sending preview...');
615         SendIPCRaw(@Preview, sizeof(Preview));
616         SendIPCRaw(@MaxHedgehogs, sizeof(byte));
617         WriteLnToConsole('Preview sent, disconnect');
618     end;
619 
620     freeEverything(false);
621 end;
622 
623 {$IFNDEF PAS2C}
624 // Write backtrace to console and log when an unhandled exception occurred
625 procedure catchUnhandledException(Obj: TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer);
626 var
627   Message: string;
628   i: LongInt;
629 begin
630   WriteLnToConsole('An unhandled exception occurred at $' + HexStr(Addr) + ':');
631   if Obj is exception then
632    begin
633      Message := Exception(Obj).ClassName + ': ' + Exception(Obj).Message;
634      WriteLnToConsole(Message);
635    end
636   else
637     WriteLnToConsole('Exception object ' + Obj.ClassName + ' is not of class Exception.');
638   WriteLnToConsole(BackTraceStrFunc(Addr));
639   if (FrameCount > 0) then
640     begin
641       for i := 0 to FrameCount - 1 do
642         WriteLnToConsole(BackTraceStrFunc(Frames[i]));
643     end;
644 end;
645 {$ENDIF}
646 
647 {$IFDEF HWLIBRARY}
RunEnginenull648 function RunEngine(argc: LongInt; argv: PPChar): LongInt; cdecl; export;
649 begin
650     operatingsystem_parameter_argc:= argc;
651     operatingsystem_parameter_argv:= argv;
652 {$ELSE}
653 begin
654 {$ENDIF}
655 
656 {$IFDEF WINDOWS}
657     ShcoreLibHandle := LoadLibrary('Shcore.dll');
658     if (ShcoreLibHandle <> 0) then
659     begin
660         SetProcessDpiAwareness :=
661             TSetProcessDpiAwareness(GetProcedureAddress(ShcoreLibHandle, 'SetProcessDpiAwareness'));
662         if (SetProcessDpiAwareness <> nil) then
663             SetProcessDpiAwareness(1);
664     end;
665 {$ENDIF}
666 
667 ///////////////////////////////////////////////////////////////////////////////
668 /////////////////////////////////// m a i n ///////////////////////////////////
669 ///////////////////////////////////////////////////////////////////////////////
670 {$IFDEF PAS2C}
671     // workaround for pascal's ParamStr and ParamCount
672     init(argc, argv);
673 {$ENDIF}
674 {$IFNDEF PAS2C}
675     // Custom procedure for unhandled exceptions; ExceptProc is used by SysUtils module
676     ExceptProc:= @catchUnhandledException;
677 {$ENDIF}
678 
679     preInitEverything();
680 
681     GetParams();
682 
683     if GameType = gmtLandPreview then
684         GenLandPreview()
685     else if (GameType <> gmtBadSyntax) and (GameType <> gmtSyntaxHelp) then
686         Game();
687 
688     // return error when engine is not called correctly
689     if GameType = gmtBadSyntax then
690         {$IFDEF PAS2C}
691         exit(HaltUsageError);
692         {$ELSE}
693         halt(HaltUsageError);
694         {$ENDIF}
695 
696     if cTestLua then
697         begin
698         WriteLnToConsole(errmsgLuaTestTerm);
699         {$IFDEF PAS2C}
700         exit(HaltTestUnexpected);
701         {$ELSE}
702         halt(HaltTestUnexpected);
703         {$ENDIF}
704         end;
705 
706     {$IFDEF PAS2C}
707         exit(HaltNoError);
708     {$ELSE}
709         {$IFDEF IPHONEOS}
710             exit(HaltNoError);
711         {$ELSE}
712             halt(HaltNoError);
713         {$ENDIF}
714     {$ENDIF}
715 {$IFDEF HWLIBRARY}
716 end;
717 {$ENDIF}
718 
719 end.
720