src/flexui/sdlcarcass.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 sdlcarcass;
  18
  19 interface
  20
  21 uses
  22   SDL2, fui_events;
  23
  24
  25 // ////////////////////////////////////////////////////////////////////////// //
  26 // call this with SDL2 event; returns `true` if event was eaten
  27 function fuiOnSDLEvent (var ev: TSDL_Event): Boolean;
  28
  29
  30 // ////////////////////////////////////////////////////////////////////////// //
  31 // event handlers
  32 var
  33   winFocusCB: procedure () = nil; // this will be called when window got focus; `fuiWinActive` already set
  34   winBlurCB: procedure () = nil; // this will be called when window lost focus; `fuiWinActive` already set
  35   // for standalone
  36   buildFrameCB: procedure () = nil; // don't do any rendering here, do it in `renderFrameCB()`
  37   renderFrameCB: procedure () = nil; // no need to call `glSwap()` here
  38   exposeFrameCB: procedure () = nil; // call `glSwap()` here instead; automatically set by standalone
  39   //
  40   prerenderFrameCB: procedure () = nil;
  41   postrenderFrameCB: procedure () = nil;
  42   fuiResizeCB: procedure () = nil; // `fuiScrWdt` and `fuiScrHgt` are already set
  43   oglInitCB: procedure () = nil; // `fuiScrWdt` and `fuiScrHgt` are already set
  44   oglDeinitCB: procedure () = nil;
  45
  46
  47 var
  48   // default size
  49   fuiScrWdt: Integer = 1024;
  50   fuiScrHgt: Integer = 768;
  51   fuiWinActive: Boolean = false;
  52   fuiQuitReceived: Boolean = false;
  53
  54
  55 // ////////////////////////////////////////////////////////////////////////// //
  56 function fuiTimeMicro (): UInt64; inline;
  57 function fuiTimeMilli (): UInt64; inline;
  58
  59
  60 // ////////////////////////////////////////////////////////////////////////// //
  61 // only for standalone mode
  62 function getFUIFPS (): Integer; inline;
  63 procedure setFUIFPS (v: Integer); inline;
  64
  65 property fuiFPS: Integer read getFUIFPS write setFUIFPS; // default: 30
  66
  67
  68 implementation
  69
  70 uses
  71   SysUtils, Classes,
  72   GL, GLExt,
  73   {$IF DEFINED(LINUX)}
  74     unixtype, linux
  75   {$ELSEIF DEFINED(WINDOWS)}
  76     Windows
  77   {$ELSE}
  78     {$WARNING You suck!}
  79   {$ENDIF}
  80   ;
  81
  82
  83 // ////////////////////////////////////////////////////////////////////////// //
  84 var
  85   gEffFPS: Integer = 30;
  86
  87 function getFUIFPS (): Integer; inline; begin result := gEffFPS; end;
  88 procedure setFUIFPS (v: Integer); inline; begin if (v < 1) then v := 1 else if (v > 60*4) then v := 60*4; gEffFPS := v; end;
  89
  90
  91 // ////////////////////////////////////////////////////////////////////////// //
  92 {$IF DEFINED(LINUX)}
  93 type THPTimeType = TTimeSpec;
  94 {$ELSE}
  95 type THPTimeType = Int64;
  96 {$ENDIF}
  97
  98 var
  99   mFrequency: Int64 = 0;
 100   mHasHPTimer: Boolean = false;
 101
 102 procedure initTimerIntr ();
 103 var
 104   r: THPTimeType;
 105 begin
 106   if (mFrequency = 0) then
 107   begin
 108 {$IF DEFINED(LINUX)}
 109     if (clock_getres(CLOCK_MONOTONIC, @r) <> 0) then raise Exception.Create('profiler error: cannot get timer resolution');
 110     mHasHPTimer := (r.tv_nsec <> 0);
 111     if not mHasHPTimer then raise Exception.Create('profiler error: hires timer is not available');
 112     mFrequency := 1; // just a flag
 113     if (r.tv_nsec <> 0) then mFrequency := 1000000000000000000 div r.tv_nsec;
 114 {$ELSE}
 115     mHasHPTimer := QueryPerformanceFrequency(r);
 116     if not mHasHPTimer then raise Exception.Create('profiler error: hires timer is not available');
 117     mFrequency := r;
 118 {$ENDIF}
 119   end;
 120 end;
 121
 122
 123 function fuiTimeMicro (): UInt64; inline;
 124 var
 125   r: THPTimeType;
 126 begin
 127   //if (mFrequency = 0) then initTimerIntr();
 128   {$IF DEFINED(LINUX)}
 129   clock_gettime(CLOCK_MONOTONIC, @r);
 130   result := UInt64(r.tv_sec)*1000000+UInt64(r.tv_nsec) div 1000; // microseconds
 131   {$ELSE}
 132   QueryPerformanceCounter(r);
 133   result := UInt64(r)*1000000 div mFrequency;
 134   {$ENDIF}
 135 end;
 136
 137
 138 function fuiTimeMilli (): UInt64; inline;
 139 begin
 140   result := fuiTimeMicro() div 1000;
 141 end;
 142
 143
 144 // ////////////////////////////////////////////////////////////////////////// //
 145 function fuiOnSDLEvent (var ev: TSDL_Event): Boolean;
 146 var
 147   mev: THMouseEvent;
 148   kev: THKeyEvent;
 149
 150   function buildBut (b: Byte): Word;
 151   begin
 152     result := 0;
 153     case b of
 154       SDL_BUTTON_LEFT: result := result or THMouseEvent.Left;
 155       SDL_BUTTON_MIDDLE: result := result or THMouseEvent.Middle;
 156       SDL_BUTTON_RIGHT: result := result or THMouseEvent.Right;
 157     end;
 158   end;
 159
 160   procedure windowEventHandler (constref ev: TSDL_WindowEvent);
 161   begin
 162     case ev.event of
 163       SDL_WINDOWEVENT_MINIMIZED: if fuiWinActive then begin fuiResetKMState(true); fuiWinActive := false; if assigned(winBlurCB) then winBlurCB(); end;
 164       SDL_WINDOWEVENT_RESIZED, SDL_WINDOWEVENT_SIZE_CHANGED:
 165         begin
 166           if (ev.data1 <> fuiScrWdt) or (ev.data2 <> fuiScrHgt) then
 167           begin
 168             fuiScrWdt := ev.data1;
 169             fuiScrHgt := ev.data2;
 170             if assigned(fuiResizeCB) then fuiResizeCB();
 171           end;
 172         end;
 173       SDL_WINDOWEVENT_EXPOSED: if assigned(exposeFrameCB) then exposeFrameCB();
 174       SDL_WINDOWEVENT_FOCUS_GAINED: if not fuiWinActive then begin fuiWinActive := true; if assigned(winFocusCB) then winFocusCB(); end;
 175       SDL_WINDOWEVENT_FOCUS_LOST: if fuiWinActive then begin fuiResetKMState(true); fuiWinActive := false; if assigned(winBlurCB) then winBlurCB(); end;
 176     end;
 177   end;
 178
 179 begin
 180   result := false;
 181
 182   case ev.type_ of
 183     SDL_WINDOWEVENT: windowEventHandler(ev.window);
 184     SDL_QUITEV: fuiQuitReceived := true;
 185
 186     SDL_KEYDOWN, SDL_KEYUP:
 187       begin
 188         // fix left/right modifiers
 189         FillChar(kev, sizeof(kev), 0);
 190         kev.intrInit();
 191         if (ev.type_ = SDL_KEYDOWN) then kev.kind := THKeyEvent.TKind.Press else kev.kind := THKeyEvent.TKind.Release;
 192         kev.scan := ev.key.keysym.scancode;
 193         //kev.sym := ev.key.keysym.sym;
 194
 195         if (kev.scan = SDL_SCANCODE_RCTRL) then kev.scan := SDL_SCANCODE_LCTRL;
 196         if (kev.scan = SDL_SCANCODE_RALT) then kev.scan := SDL_SCANCODE_LALT;
 197         if (kev.scan = SDL_SCANCODE_RSHIFT) then kev.scan := SDL_SCANCODE_LSHIFT;
 198         if (kev.scan = SDL_SCANCODE_RGUI) then kev.scan := SDL_SCANCODE_LGUI;
 199
 200         {
 201         if (kev.sym = SDLK_RCTRL) then kev.sym := SDLK_LCTRL;
 202         if (kev.sym = SDLK_RALT) then kev.sym := SDLK_LALT;
 203         if (kev.sym = SDLK_RSHIFT) then kev.sym := SDLK_LSHIFT;
 204         if (kev.sym = SDLK_RGUI) then kev.sym := SDLK_LGUI;
 205         }
 206
 207         kev.x := fuiMouseX;
 208         kev.y := fuiMouseY;
 209         kev.bstate := fuiButState;
 210         kev.kstate := fuiModState;
 211
 212         case kev.scan of
 213           SDL_SCANCODE_LCTRL: if (kev.press) then fuiSetModState(fuiModState or THKeyEvent.ModCtrl) else fuiSetModState(fuiModState and (not THKeyEvent.ModCtrl));
 214           SDL_SCANCODE_LALT: if (kev.press) then fuiSetModState(fuiModState or THKeyEvent.ModAlt) else fuiSetModState(fuiModState and (not THKeyEvent.ModAlt));
 215           SDL_SCANCODE_LSHIFT: if (kev.press) then fuiSetModState(fuiModState or THKeyEvent.ModShift) else fuiSetModState(fuiModState and (not THKeyEvent.ModShift));
 216         end;
 217
 218         if assigned(evKeyCB) then
 219         begin
 220           evKeyCB(kev);
 221           result := kev.eaten;
 222         end;
 223       end;
 224
 225     SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP:
 226       begin
 227         FillChar(mev, sizeof(mev), 0);
 228         mev.intrInit();
 229         if (ev.type_ = SDL_MOUSEBUTTONDOWN) then mev.kind := THMouseEvent.TKind.Press else mev.kind := THMouseEvent.TKind.Release;
 230         mev.dx := ev.button.x-fuiMouseX;
 231         mev.dy := ev.button.y-fuiMouseY;
 232         fuiSetMouseX(ev.button.x);
 233         fuiSetMouseY(ev.button.y);
 234         mev.but := buildBut(ev.button.button);
 235         mev.x := fuiMouseX;
 236         mev.y := fuiMouseY;
 237         mev.bstate := fuiButState;
 238         mev.kstate := fuiModState;
 239         if (mev.but <> 0) then
 240         begin
 241           // ev.button.clicks: Byte
 242           if (ev.type_ = SDL_MOUSEBUTTONDOWN) then fuiSetButState(fuiButState or mev.but) else fuiSetButState(fuiButState and (not mev.but));
 243           if assigned(evMouseCB) then
 244           begin
 245             evMouseCB(mev);
 246             result := mev.eaten;
 247           end;
 248         end;
 249       end;
 250     SDL_MOUSEWHEEL:
 251       begin
 252         if (ev.wheel.y <> 0) then
 253         begin
 254           FillChar(mev, sizeof(mev), 0);
 255           mev.intrInit();
 256           mev.kind := THMouseEvent.TKind.Press;
 257           mev.dx := 0;
 258           mev.dy := ev.wheel.y;
 259           if (ev.wheel.y < 0) then mev.but := THMouseEvent.WheelUp else mev.but := THMouseEvent.WheelDown;
 260           mev.x := fuiMouseX;
 261           mev.y := fuiMouseY;
 262           mev.bstate := fuiButState;
 263           mev.kstate := fuiModState;
 264           if assigned(evMouseCB) then
 265           begin
 266             evMouseCB(mev);
 267             result := mev.eaten;
 268           end;
 269         end;
 270       end;
 271     SDL_MOUSEMOTION:
 272       begin
 273         FillChar(mev, sizeof(mev), 0);
 274         mev.intrInit();
 275         mev.kind := THMouseEvent.TKind.Motion;
 276         mev.dx := ev.button.x-fuiMouseX;
 277         mev.dy := ev.button.y-fuiMouseY;
 278         fuiSetMouseX(ev.button.x);
 279         fuiSetMouseY(ev.button.y);
 280         mev.but := 0;
 281         mev.x := fuiMouseX;
 282         mev.y := fuiMouseY;
 283         mev.bstate := fuiButState;
 284         mev.kstate := fuiModState;
 285         if assigned(evMouseCB) then
 286         begin
 287           evMouseCB(mev);
 288           result := mev.eaten;
 289         end;
 290       end;
 291
 292     {
 293     SDL_TEXTINPUT:
 294       begin
 295         Utf8ToUnicode(@uc, PChar(ev.text.text), 1);
 296         keychr := Word(uc);
 297         if (keychr > 127) then keychr := Word(wchar2win(WideChar(keychr)));
 298         CharPress(AnsiChar(keychr));
 299       end;
 300     }
 301   end;
 302 end;
 303
 304
 305 begin
 306   initTimerIntr();
 307   fuiWinActive := fuiWinActive;
 308   fuiScrWdt := fuiScrWdt;
 309   fuiScrHgt := fuiScrHgt;
 310 end.