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