src/flexui/sdlstandalone.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 unit sdlstandalone;
  18
  19 interface
  20
  21 uses
  22   SDL2,
  23   sdlcarcass;
  24
  25
  26 // ////////////////////////////////////////////////////////////////////////// //
  27 // initialize OpenGL; set `gScreenWidth` and `gScreenHeight` before calling this
  28 function glInit (const winTitle: AnsiString='SDL TEST'): Boolean;
  29 procedure glDeinit ();
  30 // call this to show built frame
  31 procedure glSwap ();
  32 // call this to push "quit" event into queue
  33 procedure pushQuitEvent ();
  34 // call this to process queued messages; result is `true` if quit event was received
  35 function processMessages (): Boolean;
  36
  37 // run main loop, call `buildFrameCB()` and `renderFrameCB()`, maintain the given FPS
  38 procedure mainLoop ();
  39
  40
  41 implementation
  42
  43 uses
  44   SysUtils;
  45
  46
  47 var
  48   gWinH: PSDL_Window = nil;
  49   gGLContext: TSDL_GLContext = nil;
  50   lastFrameTime: UInt64 = 0;
  51
  52
  53 // ////////////////////////////////////////////////////////////////////////// //
  54 procedure onExposeFrame ();
  55 begin
  56   glSwap();
  57 end;
  58
  59
  60 // ////////////////////////////////////////////////////////////////////////// //
  61 function sdlInit (): Boolean;
  62 var
  63   sdlflags: LongWord;
  64 begin
  65   result := false;
  66
  67   sdlflags := SDL_INIT_TIMER or SDL_INIT_VIDEO;
  68   if SDL_Init(sdlflags) < 0 then exit; //raise Exception.Create('SDL: Init failed: ' + SDL_GetError());
  69
  70   //SDL_Quit();
  71   result := true;
  72   fuiWinActive := fuiWinActive;
  73 end;
  74
  75
  76 procedure glSwap ();
  77 begin
  78   if (gWinH = nil) then exit;
  79   SDL_GL_SwapWindow(gWinH);
  80 end;
  81
  82
  83 procedure killGLWindow ();
  84 begin
  85   if (gWinH <> nil) then SDL_DestroyWindow(gWinH);
  86   if (gGLContext <> nil) then SDL_GL_DeleteContext(gGLContext);
  87   gWinH := nil;
  88   gGLContext := nil;
  89 end;
  90
  91
  92 procedure pushQuitEvent ();
  93 var
  94   ev: TSDL_Event;
  95 begin
  96   ev.type_ := SDL_QUITEV;
  97   SDL_PushEvent(@ev);
  98 end;
  99
 100
 101 // ////////////////////////////////////////////////////////////////////////// //
 102 // true: quit
 103 function processMessages (): Boolean;
 104 var
 105   ev: TSDL_Event;
 106 begin
 107   result := false;
 108   FillChar(ev, sizeof(ev), 0);
 109   while (SDL_PollEvent(@ev) > 0) do
 110   begin
 111     if fuiOnSDLEvent(ev) then result := true;
 112     //if (ev.type_ = SDL_QUITEV) then exit;
 113   end;
 114 end;
 115
 116
 117 // ////////////////////////////////////////////////////////////////////////// //
 118 procedure glDeinit ();
 119 begin
 120   if (gWinH <> nil) and assigned(oglDeinitCB) then oglDeinitCB();
 121   killGLWindow();
 122 end;
 123
 124
 125 function glInit (const winTitle: AnsiString='SDL TEST'): Boolean;
 126 var
 127   wFlags: LongWord = 0;
 128   v: Byte = 0;
 129 begin
 130   result := false;
 131
 132   wFlags := SDL_WINDOW_OPENGL or SDL_WINDOW_RESIZABLE;
 133   //if gFullscreen then wFlags := wFlags or SDL_WINDOW_FULLSCREEN;
 134   //if gWinMaximized then wFlags := wFlags or SDL_WINDOW_MAXIMIZED;
 135
 136   glDeinit();
 137
 138   //if VSync then v := 1 else v := 0;
 139   SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 2);
 140   SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 1);
 141   SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 8);
 142   SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 8);
 143   SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 8);
 144   SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16);
 145   SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
 146   SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE, 1); // lights; it is enough to have 1-bit stencil buffer for lighting
 147   SDL_GL_SetSwapInterval(v);
 148
 149   {
 150   if gFullscreen then
 151   begin
 152     mode.w := gScreenWidth;
 153     mode.h := gScreenHeight;
 154     mode.format := 0;
 155     mode.refresh_rate := 0;
 156     mode.driverdata := nil;
 157     if SDL_GetClosestDisplayMode(0, @mode, @cmode) = nil then
 158     begin
 159       gScreenWidth := 800;
 160       gScreenHeight := 600;
 161     end
 162     else
 163     begin
 164       gScreenWidth := cmode.w;
 165       gScreenHeight := cmode.h;
 166     end;
 167   end;
 168   }
 169
 170   gWinH := SDL_CreateWindow(PAnsiChar(winTitle), -1, -1, fuiScrWdt, fuiScrHgt, wFlags);
 171   if (gWinH = nil) then exit;
 172
 173   gGLContext := SDL_GL_CreateContext(gWinH);
 174   if (gGLContext = nil) then begin SDL_DestroyWindow(gWinH); gWinH := nil; exit; end;
 175
 176   SDL_GL_MakeCurrent(gWinH, gGLContext);
 177   SDL_ShowCursor(SDL_DISABLE);
 178
 179   if assigned(oglInitCB) then oglInitCB();
 180
 181   result := true;
 182 end;
 183
 184
 185 // run main loop, call `buildFrameCB()` and `renderFrameCB()`, maintain the given FPS
 186 procedure mainLoop ();
 187 var
 188   nft, ctt: UInt64;
 189   wt: Integer;
 190 begin
 191   if assigned(buildFrameCB) then buildFrameCB();
 192   if assigned(prerenderFrameCB) then prerenderFrameCB();
 193   if assigned(renderFrameCB) then renderFrameCB();
 194   if assigned(postrenderFrameCB) then postrenderFrameCB();
 195   glSwap();
 196   lastFrameTime := fuiTimeMilli();
 197   while true do
 198   begin
 199     // calculate time to build and render next frame
 200     nft := lastFrameTime+(1000 div fuiFPS);
 201     ctt := fuiTimeMilli();
 202     if (ctt >= nft) then
 203     begin
 204       // time to build next frame
 205       if assigned(buildFrameCB) then buildFrameCB();
 206       if assigned(prerenderFrameCB) then prerenderFrameCB();
 207       if assigned(renderFrameCB) then renderFrameCB();
 208       if assigned(postrenderFrameCB) then postrenderFrameCB();
 209       glSwap();
 210       lastFrameTime := ctt; // ignore frame processing time
 211     end
 212     else
 213     begin
 214       // has to wait for some time
 215       if (nft-ctt > 1000) then wt := 1000 else wt := Integer(nft-ctt);
 216       SDL_WaitEventTimeout(nil, wt);
 217     end;
 218     if processMessages() then break; // just in case
 219   end;
 220 end;
 221
 222
 223 initialization
 224   exposeFrameCB := onExposeFrame();
 225
 226   if not sdlInit() then raise Exception.Create('cannot initialize SDL');
 227 finalization
 228   glDeinit();
 229   SDL_Quit();
 230 end.