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