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     fuiOnSDLEvent(ev);
 112     //if (ev.type_ = SDL_QUITEV) then exit;
 113   end;
 114   if fuiQuitReceived then result := true;
 115 end;
 116
 117
 118 // ////////////////////////////////////////////////////////////////////////// //
 119 procedure glDeinit ();
 120 begin
 121   if (gWinH <> nil) and assigned(oglDeinitCB) then oglDeinitCB();
 122   killGLWindow();
 123 end;
 124
 125
 126 function glInit (const winTitle: AnsiString='SDL TEST'): Boolean;
 127 var
 128   wFlags: LongWord = 0;
 129   v: Byte = 0;
 130 begin
 131   result := false;
 132
 133   wFlags := SDL_WINDOW_OPENGL or SDL_WINDOW_RESIZABLE;
 134   //if gFullscreen then wFlags := wFlags or SDL_WINDOW_FULLSCREEN;
 135   //if gWinMaximized then wFlags := wFlags or SDL_WINDOW_MAXIMIZED;
 136
 137   glDeinit();
 138
 139   //if VSync then v := 1 else v := 0;
 140   SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 2);
 141   SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 1);
 142   SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 8);
 143   SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 8);
 144   SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 8);
 145   SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16);
 146   SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
 147   SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE, 1); // lights; it is enough to have 1-bit stencil buffer for lighting
 148   SDL_GL_SetSwapInterval(v);
 149
 150   {
 151   if gFullscreen then
 152   begin
 153     mode.w := gScreenWidth;
 154     mode.h := gScreenHeight;
 155     mode.format := 0;
 156     mode.refresh_rate := 0;
 157     mode.driverdata := nil;
 158     if SDL_GetClosestDisplayMode(0, @mode, @cmode) = nil then
 159     begin
 160       gScreenWidth := 800;
 161       gScreenHeight := 600;
 162     end
 163     else
 164     begin
 165       gScreenWidth := cmode.w;
 166       gScreenHeight := cmode.h;
 167     end;
 168   end;
 169   }
 170
 171   gWinH := SDL_CreateWindow(PAnsiChar(winTitle), -1, -1, fuiScrWdt, fuiScrHgt, wFlags);
 172   if (gWinH = nil) then exit;
 173
 174   gGLContext := SDL_GL_CreateContext(gWinH);
 175   if (gGLContext = nil) then begin SDL_DestroyWindow(gWinH); gWinH := nil; exit; end;
 176
 177   SDL_GL_MakeCurrent(gWinH, gGLContext);
 178   SDL_ShowCursor(SDL_DISABLE);
 179
 180   if assigned(oglInitCB) then oglInitCB();
 181
 182   result := true;
 183 end;
 184
 185
 186 // run main loop, call `buildFrameCB()` and `renderFrameCB()`, maintain the given FPS
 187 procedure mainLoop ();
 188 var
 189   nft, ctt: UInt64;
 190   wt: Integer;
 191 begin
 192   if assigned(buildFrameCB) then buildFrameCB();
 193   if assigned(prerenderFrameCB) then prerenderFrameCB();
 194   if assigned(renderFrameCB) then renderFrameCB();
 195   if assigned(postrenderFrameCB) then postrenderFrameCB();
 196   glSwap();
 197   lastFrameTime := fuiTimeMilli();
 198   while true do
 199   begin
 200     // calculate time to build and render next frame
 201     nft := lastFrameTime+(1000 div fuiFPS);
 202     ctt := fuiTimeMilli();
 203     if (ctt >= nft) then
 204     begin
 205       // time to build next frame
 206       if assigned(buildFrameCB) then buildFrameCB();
 207       if assigned(prerenderFrameCB) then prerenderFrameCB();
 208       if assigned(renderFrameCB) then renderFrameCB();
 209       if assigned(postrenderFrameCB) then postrenderFrameCB();
 210       glSwap();
 211       lastFrameTime := ctt; // ignore frame processing time
 212     end
 213     else
 214     begin
 215       // has to wait for some time
 216       if (nft-ctt > 1000) then wt := 1000 else wt := Integer(nft-ctt);
 217       SDL_WaitEventTimeout(nil, wt);
 218     end;
 219     if processMessages() then break; // just in case
 220   end;
 221 end;
 222
 223
 224 initialization
 225   exposeFrameCB := onExposeFrame();
 226
 227   if not sdlInit() then raise Exception.Create('cannot initialize SDL');
 228 finalization
 229   glDeinit();
 230   SDL_Quit();
 231 end.