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   {$IFNDEF USE_SDL2}
  19     {$FATAL SDL2 required for flexui sdlcarcass}
  20   {$ENDIF}
  21
  22 interface
  23
  24 uses
  25   SDL2, fui_events;
  26
  27
  28 // ////////////////////////////////////////////////////////////////////////// //
  29 // call this with SDL2 event; returns `true` if event was eaten
  30 function fuiOnSDLEvent (var ev: TSDL_Event): Boolean;
  31
  32
  33 // ////////////////////////////////////////////////////////////////////////// //
  34 // event handlers
  35 var
  36   winFocusCB: procedure () = nil; // this will be called when window got focus; `fuiWinActive` already set
  37   winBlurCB: procedure () = nil; // this will be called when window lost focus; `fuiWinActive` already set
  38   // for standalone
  39   buildFrameCB: procedure () = nil; // don't do any rendering here, do it in `renderFrameCB()`
  40   renderFrameCB: procedure () = nil; // no need to call `glSwap()` here
  41   exposeFrameCB: procedure () = nil; // call `glSwap()` here instead; automatically set by standalone
  42   //
  43   prerenderFrameCB: procedure () = nil;
  44   postrenderFrameCB: procedure () = nil;
  45   fuiResizeCB: procedure () = nil; // `fuiScrWdt` and `fuiScrHgt` are already set
  46   oglInitCB: procedure () = nil; // `fuiScrWdt` and `fuiScrHgt` are already set
  47   oglDeinitCB: procedure () = nil;
  48
  49
  50 var
  51   // default size
  52   fuiScrWdt: Integer = 1024;
  53   fuiScrHgt: Integer = 768;
  54   fuiWinActive: Boolean = false;
  55   fuiQuitReceived: Boolean = false;
  56
  57
  58 // ////////////////////////////////////////////////////////////////////////// //
  59 function fuiTimeMicro (): UInt64; inline;
  60 function fuiTimeMilli (): UInt64; inline;
  61
  62
  63 // ////////////////////////////////////////////////////////////////////////// //
  64 // only for standalone mode
  65 function getFUIFPS (): Integer; inline;
  66 procedure setFUIFPS (v: Integer); inline;
  67
  68 property fuiFPS: Integer read getFUIFPS write setFUIFPS; // default: 30
  69
  70
  71 implementation
  72
  73 uses
  74   SysUtils, Classes,
  75   {$IF DEFINED(LINUX) OR DEFINED(ANDROID)}
  76     unixtype, linux
  77   {$ELSEIF DEFINED(WINDOWS)}
  78     Windows
  79   {$ELSEIF DEFINED(HAIKU) OR DEFINED(UNIX)}
  80     unixtype
  81   {$ELSE}
  82     {$WARNING You suck!}
  83   {$ENDIF}
  84   ;
  85
  86
  87 // ////////////////////////////////////////////////////////////////////////// //
  88 var
  89   gEffFPS: Integer = 30;
  90
  91 function getFUIFPS (): Integer; inline; begin result := gEffFPS; end;
  92 procedure setFUIFPS (v: Integer); inline; begin if (v < 1) then v := 1 else if (v > 60*4) then v := 60*4; gEffFPS := v; end;
  93
  94
  95 // ////////////////////////////////////////////////////////////////////////// //
  96 {$IF DEFINED(LINUX)}
  97 type THPTimeType = TTimeSpec;
  98 {$ELSE}
  99 type THPTimeType = Int64;
 100 {$ENDIF}
 101
 102 var
 103   mFrequency: Int64 = 0;
 104   mHasHPTimer: Boolean = false;
 105
 106 procedure initTimerIntr ();
 107 var
 108   r: THPTimeType;
 109 begin
 110   if (mFrequency = 0) then
 111   begin
 112 {$IF DEFINED(LINUX)}
 113     if (clock_getres(CLOCK_MONOTONIC, @r) <> 0) then raise Exception.Create('profiler error: cannot get timer resolution');
 114     mHasHPTimer := (r.tv_nsec <> 0);
 115     if not mHasHPTimer then raise Exception.Create('profiler error: hires timer is not available');
 116     mFrequency := 1; // just a flag
 117     if (r.tv_nsec <> 0) then mFrequency := 1000000000000000000 div r.tv_nsec;
 118 {$ELSEIF DEFINED(WINDOWS)}
 119     mHasHPTimer := QueryPerformanceFrequency(r);
 120     if not mHasHPTimer then raise Exception.Create('profiler error: hires timer is not available');
 121     mFrequency := r;
 122 {$ENDIF}
 123   end;
 124 end;
 125
 126
 127 function fuiTimeMicro (): UInt64; inline;
 128 var
 129   r: THPTimeType;
 130 begin
 131   //if (mFrequency = 0) then initTimerIntr();
 132   {$IF DEFINED(LINUX)}
 133   clock_gettime(CLOCK_MONOTONIC, @r);
 134   result := UInt64(r.tv_sec)*1000000+UInt64(r.tv_nsec) div 1000; // microseconds
 135   {$ELSEIF DEFINED(WINDOWS)}
 136   QueryPerformanceCounter(r);
 137   result := UInt64(r)*1000000 div mFrequency;
 138   {$ENDIF}
 139 end;
 140
 141
 142 function fuiTimeMilli (): UInt64; inline;
 143 begin
 144   result := fuiTimeMicro() div 1000;
 145 end;
 146
 147
 148 // ////////////////////////////////////////////////////////////////////////// //
 149 var
 150   wc2shitmap: array[0..65535] of AnsiChar;
 151   wc2shitmapInited: Boolean = false;
 152
 153
 154 // ////////////////////////////////////////////////////////////////////////// //
 155 const
 156   cp1251: array[0..127] of Word = (
 157     $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
 158     $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
 159     $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
 160     $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
 161     $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
 162     $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
 163     $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
 164     $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
 165   );
 166
 167
 168 procedure initShitMap ();
 169 var
 170   f: Integer;
 171 begin
 172   for f := 0 to High(wc2shitmap) do wc2shitmap[f] := '?';
 173   for f := 0 to 127 do wc2shitmap[f] := AnsiChar(f);
 174   for f := 0 to 127 do wc2shitmap[cp1251[f]] := AnsiChar(f+128);
 175   wc2shitmapInited := true;
 176 end;
 177
 178
 179 function wchar2win (wc: WideChar): AnsiChar; inline;
 180 begin
 181   if not wc2shitmapInited then initShitMap();
 182   if (LongWord(wc) > 65535) then result := '?' else result := wc2shitmap[LongWord(wc)];
 183 end;
 184
 185
 186 // ////////////////////////////////////////////////////////////////////////// //
 187 function fuiOnSDLEvent (var ev: TSDL_Event): Boolean;
 188 var
 189   fev: TFUIEvent;
 190   uc: UnicodeChar;
 191   keychr: Word;
 192
 193   function buildBut (b: Byte): Word;
 194   begin
 195     result := 0;
 196     case b of
 197       SDL_BUTTON_LEFT: result := result or TFUIEvent.Left;
 198       SDL_BUTTON_MIDDLE: result := result or TFUIEvent.Middle;
 199       SDL_BUTTON_RIGHT: result := result or TFUIEvent.Right;
 200     end;
 201   end;
 202
 203   procedure windowEventHandler (constref ev: TSDL_WindowEvent);
 204   begin
 205     case ev.event of
 206       SDL_WINDOWEVENT_MINIMIZED: if fuiWinActive then begin fuiResetKMState(true); fuiWinActive := false; if assigned(winBlurCB) then winBlurCB(); end;
 207       SDL_WINDOWEVENT_RESIZED, SDL_WINDOWEVENT_SIZE_CHANGED:
 208         begin
 209           if (ev.data1 <> fuiScrWdt) or (ev.data2 <> fuiScrHgt) then
 210           begin
 211             fuiScrWdt := ev.data1;
 212             fuiScrHgt := ev.data2;
 213             if assigned(fuiResizeCB) then fuiResizeCB();
 214           end;
 215         end;
 216       SDL_WINDOWEVENT_EXPOSED: if assigned(exposeFrameCB) then exposeFrameCB();
 217       SDL_WINDOWEVENT_FOCUS_GAINED: if not fuiWinActive then begin fuiWinActive := true; if assigned(winFocusCB) then winFocusCB(); end;
 218       SDL_WINDOWEVENT_FOCUS_LOST: if fuiWinActive then begin fuiResetKMState(true); fuiWinActive := false; if assigned(winBlurCB) then winBlurCB(); end;
 219     end;
 220   end;
 221
 222 begin
 223   result := false;
 224
 225   case ev.type_ of
 226     SDL_WINDOWEVENT: windowEventHandler(ev.window);
 227     SDL_QUITEV: fuiQuitReceived := true;
 228
 229     SDL_KEYDOWN, SDL_KEYUP:
 230       begin
 231         // fix left/right modifiers
 232         if (ev.type_ = SDL_KEYDOWN) then
 233         begin
 234           fev := TFUIEvent.Create(TFUIEvent.TType.Key, TFUIEvent.TKind.Press);
 235         end
 236         else
 237         begin
 238           fev := TFUIEvent.Create(TFUIEvent.TType.Key, TFUIEvent.TKind.Release);
 239         end;
 240         fev.scan := ev.key.keysym.scancode;
 241
 242         if (fev.scan = SDL_SCANCODE_RCTRL) then fev.scan := SDL_SCANCODE_LCTRL;
 243         if (fev.scan = SDL_SCANCODE_RALT) then fev.scan := SDL_SCANCODE_LALT;
 244         if (fev.scan = SDL_SCANCODE_RSHIFT) then fev.scan := SDL_SCANCODE_LSHIFT;
 245         if (fev.scan = SDL_SCANCODE_RGUI) then fev.scan := SDL_SCANCODE_LGUI;
 246
 247         fev.x := fuiMouseX;
 248         fev.y := fuiMouseY;
 249         fev.bstate := fuiButState;
 250         fev.kstate := fuiModState;
 251
 252         case fev.scan of
 253           SDL_SCANCODE_LCTRL: if (fev.press) then fuiSetModState(fuiModState or TFUIEvent.ModCtrl) else fuiSetModState(fuiModState and (not TFUIEvent.ModCtrl));
 254           SDL_SCANCODE_LALT: if (fev.press) then fuiSetModState(fuiModState or TFUIEvent.ModAlt) else fuiSetModState(fuiModState and (not TFUIEvent.ModAlt));
 255           SDL_SCANCODE_LSHIFT: if (fev.press) then fuiSetModState(fuiModState or TFUIEvent.ModShift) else fuiSetModState(fuiModState and (not TFUIEvent.ModShift));
 256         end;
 257
 258         if (assigned(fuiEventCB)) then
 259         begin
 260           fuiEventCB(fev);
 261           result := fev.eaten;
 262         end;
 263       end;
 264
 265     SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP:
 266       begin
 267         if (ev.type_ = SDL_MOUSEBUTTONDOWN) then
 268         begin
 269           fev := TFUIEvent.Create(TFUIEvent.TType.Mouse, TFUIEvent.TKind.Press);
 270         end
 271         else
 272         begin
 273           fev := TFUIEvent.Create(TFUIEvent.TType.Mouse, TFUIEvent.TKind.Release);
 274         end;
 275         fev.dx := ev.button.x-fuiMouseX;
 276         fev.dy := ev.button.y-fuiMouseY;
 277         fuiSetMouseX(ev.button.x);
 278         fuiSetMouseY(ev.button.y);
 279         fev.but := buildBut(ev.button.button);
 280         fev.x := fuiMouseX;
 281         fev.y := fuiMouseY;
 282         fev.bstate := fuiButState;
 283         fev.kstate := fuiModState;
 284         if (fev.but <> 0) then
 285         begin
 286           // ev.button.clicks: Byte
 287           if (ev.type_ = SDL_MOUSEBUTTONDOWN) then fuiSetButState(fuiButState or fev.but) else fuiSetButState(fuiButState and (not fev.but));
 288           if (assigned(fuiEventCB)) then
 289           begin
 290             fuiEventCB(fev);
 291             result := fev.eaten;
 292           end;
 293         end;
 294       end;
 295     SDL_MOUSEWHEEL:
 296       begin
 297         if (ev.wheel.y <> 0) then
 298         begin
 299           fev := TFUIEvent.Create(TFUIEvent.TType.Mouse, TFUIEvent.TKind.Press);
 300           fev.dx := 0;
 301           fev.dy := ev.wheel.y;
 302           if (ev.wheel.y < 0) then fev.but := TFUIEvent.WheelUp else fev.but := TFUIEvent.WheelDown;
 303           fev.x := fuiMouseX;
 304           fev.y := fuiMouseY;
 305           fev.bstate := fuiButState;
 306           fev.kstate := fuiModState;
 307           if (assigned(fuiEventCB)) then
 308           begin
 309             fuiEventCB(fev);
 310             result := fev.eaten;
 311           end;
 312         end;
 313       end;
 314     SDL_MOUSEMOTION:
 315       begin
 316         fev := TFUIEvent.Create(TFUIEvent.TType.Mouse, TFUIEvent.TKind.Motion);
 317         fev.dx := ev.button.x-fuiMouseX;
 318         fev.dy := ev.button.y-fuiMouseY;
 319         fuiSetMouseX(ev.button.x);
 320         fuiSetMouseY(ev.button.y);
 321         fev.but := 0;
 322         fev.x := fuiMouseX;
 323         fev.y := fuiMouseY;
 324         fev.bstate := fuiButState;
 325         fev.kstate := fuiModState;
 326         if (assigned(fuiEventCB)) then
 327         begin
 328           fuiEventCB(fev);
 329           result := fev.eaten;
 330         end;
 331       end;
 332
 333     SDL_TEXTINPUT:
 334       if ((fuiModState and (not TFUIEvent.ModShift)) = 0) then
 335       begin
 336         Utf8ToUnicode(@uc, PChar(ev.text.text), 1);
 337         keychr := Word(uc);
 338         if (keychr > 127) then keychr := Word(wchar2win(WideChar(keychr)));
 339         if (keychr > 0) and (assigned(fuiEventCB)) then
 340         begin
 341           fev := TFUIEvent.Create(TFUIEvent.TType.Key, TFUIEvent.TKind.SimpleChar);
 342           fev.ch := AnsiChar(keychr);
 343           fev.x := fuiMouseX;
 344           fev.y := fuiMouseY;
 345           fev.bstate := fuiButState;
 346           fev.kstate := fuiModState;
 347           fuiEventCB(fev);
 348           result := fev.eaten;
 349         end;
 350       end;
 351   end;
 352 end;
 353
 354
 355 begin
 356   initTimerIntr();
 357   fuiWinActive := fuiWinActive;
 358   fuiScrWdt := fuiScrWdt;
 359   fuiScrHgt := fuiScrHgt;
 360 end.