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,
  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)}
  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 var
 147   wc2shitmap: array[0..65535] of AnsiChar;
 148   wc2shitmapInited: Boolean = false;
 149
 150
 151 // ////////////////////////////////////////////////////////////////////////// //
 152 const
 153   cp1251: array[0..127] of Word = (
 154     $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
 155     $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
 156     $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
 157     $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
 158     $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
 159     $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
 160     $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
 161     $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
 162   );
 163
 164
 165 procedure initShitMap ();
 166 var
 167   f: Integer;
 168 begin
 169   for f := 0 to High(wc2shitmap) do wc2shitmap[f] := '?';
 170   for f := 0 to 127 do wc2shitmap[f] := AnsiChar(f);
 171   for f := 0 to 127 do wc2shitmap[cp1251[f]] := AnsiChar(f+128);
 172   wc2shitmapInited := true;
 173 end;
 174
 175
 176 function wchar2win (wc: WideChar): AnsiChar; inline;
 177 begin
 178   if not wc2shitmapInited then initShitMap();
 179   if (LongWord(wc) > 65535) then result := '?' else result := wc2shitmap[LongWord(wc)];
 180 end;
 181
 182
 183 // ////////////////////////////////////////////////////////////////////////// //
 184 function fuiOnSDLEvent (var ev: TSDL_Event): Boolean;
 185 var
 186   fev: TFUIEvent;
 187   uc: UnicodeChar;
 188   keychr: Word;
 189
 190   function buildBut (b: Byte): Word;
 191   begin
 192     result := 0;
 193     case b of
 194       SDL_BUTTON_LEFT: result := result or TFUIEvent.Left;
 195       SDL_BUTTON_MIDDLE: result := result or TFUIEvent.Middle;
 196       SDL_BUTTON_RIGHT: result := result or TFUIEvent.Right;
 197     end;
 198   end;
 199
 200   procedure windowEventHandler (constref ev: TSDL_WindowEvent);
 201   begin
 202     case ev.event of
 203       SDL_WINDOWEVENT_MINIMIZED: if fuiWinActive then begin fuiResetKMState(true); fuiWinActive := false; if assigned(winBlurCB) then winBlurCB(); end;
 204       SDL_WINDOWEVENT_RESIZED, SDL_WINDOWEVENT_SIZE_CHANGED:
 205         begin
 206           if (ev.data1 <> fuiScrWdt) or (ev.data2 <> fuiScrHgt) then
 207           begin
 208             fuiScrWdt := ev.data1;
 209             fuiScrHgt := ev.data2;
 210             if assigned(fuiResizeCB) then fuiResizeCB();
 211           end;
 212         end;
 213       SDL_WINDOWEVENT_EXPOSED: if assigned(exposeFrameCB) then exposeFrameCB();
 214       SDL_WINDOWEVENT_FOCUS_GAINED: if not fuiWinActive then begin fuiWinActive := true; if assigned(winFocusCB) then winFocusCB(); end;
 215       SDL_WINDOWEVENT_FOCUS_LOST: if fuiWinActive then begin fuiResetKMState(true); fuiWinActive := false; if assigned(winBlurCB) then winBlurCB(); end;
 216     end;
 217   end;
 218
 219 begin
 220   result := false;
 221
 222   case ev.type_ of
 223     SDL_WINDOWEVENT: windowEventHandler(ev.window);
 224     SDL_QUITEV: fuiQuitReceived := true;
 225
 226     SDL_KEYDOWN, SDL_KEYUP:
 227       begin
 228         // fix left/right modifiers
 229         if (ev.type_ = SDL_KEYDOWN) then
 230         begin
 231           fev := TFUIEvent.Create(TFUIEvent.TType.Key, TFUIEvent.TKind.Press);
 232         end
 233         else
 234         begin
 235           fev := TFUIEvent.Create(TFUIEvent.TType.Key, TFUIEvent.TKind.Release);
 236         end;
 237         fev.scan := ev.key.keysym.scancode;
 238
 239         if (fev.scan = SDL_SCANCODE_RCTRL) then fev.scan := SDL_SCANCODE_LCTRL;
 240         if (fev.scan = SDL_SCANCODE_RALT) then fev.scan := SDL_SCANCODE_LALT;
 241         if (fev.scan = SDL_SCANCODE_RSHIFT) then fev.scan := SDL_SCANCODE_LSHIFT;
 242         if (fev.scan = SDL_SCANCODE_RGUI) then fev.scan := SDL_SCANCODE_LGUI;
 243
 244         fev.x := fuiMouseX;
 245         fev.y := fuiMouseY;
 246         fev.bstate := fuiButState;
 247         fev.kstate := fuiModState;
 248
 249         case fev.scan of
 250           SDL_SCANCODE_LCTRL: if (fev.press) then fuiSetModState(fuiModState or TFUIEvent.ModCtrl) else fuiSetModState(fuiModState and (not TFUIEvent.ModCtrl));
 251           SDL_SCANCODE_LALT: if (fev.press) then fuiSetModState(fuiModState or TFUIEvent.ModAlt) else fuiSetModState(fuiModState and (not TFUIEvent.ModAlt));
 252           SDL_SCANCODE_LSHIFT: if (fev.press) then fuiSetModState(fuiModState or TFUIEvent.ModShift) else fuiSetModState(fuiModState and (not TFUIEvent.ModShift));
 253         end;
 254
 255         if (assigned(fuiEventCB)) then
 256         begin
 257           fuiEventCB(fev);
 258           result := fev.eaten;
 259         end;
 260       end;
 261
 262     SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP:
 263       begin
 264         if (ev.type_ = SDL_MOUSEBUTTONDOWN) then
 265         begin
 266           fev := TFUIEvent.Create(TFUIEvent.TType.Mouse, TFUIEvent.TKind.Press);
 267         end
 268         else
 269         begin
 270           fev := TFUIEvent.Create(TFUIEvent.TType.Mouse, TFUIEvent.TKind.Release);
 271         end;
 272         fev.dx := ev.button.x-fuiMouseX;
 273         fev.dy := ev.button.y-fuiMouseY;
 274         fuiSetMouseX(ev.button.x);
 275         fuiSetMouseY(ev.button.y);
 276         fev.but := buildBut(ev.button.button);
 277         fev.x := fuiMouseX;
 278         fev.y := fuiMouseY;
 279         fev.bstate := fuiButState;
 280         fev.kstate := fuiModState;
 281         if (fev.but <> 0) then
 282         begin
 283           // ev.button.clicks: Byte
 284           if (ev.type_ = SDL_MOUSEBUTTONDOWN) then fuiSetButState(fuiButState or fev.but) else fuiSetButState(fuiButState and (not fev.but));
 285           if (assigned(fuiEventCB)) then
 286           begin
 287             fuiEventCB(fev);
 288             result := fev.eaten;
 289           end;
 290         end;
 291       end;
 292     SDL_MOUSEWHEEL:
 293       begin
 294         if (ev.wheel.y <> 0) then
 295         begin
 296           fev := TFUIEvent.Create(TFUIEvent.TType.Mouse, TFUIEvent.TKind.Press);
 297           fev.dx := 0;
 298           fev.dy := ev.wheel.y;
 299           if (ev.wheel.y < 0) then fev.but := TFUIEvent.WheelUp else fev.but := TFUIEvent.WheelDown;
 300           fev.x := fuiMouseX;
 301           fev.y := fuiMouseY;
 302           fev.bstate := fuiButState;
 303           fev.kstate := fuiModState;
 304           if (assigned(fuiEventCB)) then
 305           begin
 306             fuiEventCB(fev);
 307             result := fev.eaten;
 308           end;
 309         end;
 310       end;
 311     SDL_MOUSEMOTION:
 312       begin
 313         fev := TFUIEvent.Create(TFUIEvent.TType.Mouse, TFUIEvent.TKind.Motion);
 314         fev.dx := ev.button.x-fuiMouseX;
 315         fev.dy := ev.button.y-fuiMouseY;
 316         fuiSetMouseX(ev.button.x);
 317         fuiSetMouseY(ev.button.y);
 318         fev.but := 0;
 319         fev.x := fuiMouseX;
 320         fev.y := fuiMouseY;
 321         fev.bstate := fuiButState;
 322         fev.kstate := fuiModState;
 323         if (assigned(fuiEventCB)) then
 324         begin
 325           fuiEventCB(fev);
 326           result := fev.eaten;
 327         end;
 328       end;
 329
 330     SDL_TEXTINPUT:
 331       if ((fuiModState and (not TFUIEvent.ModShift)) = 0) then
 332       begin
 333         Utf8ToUnicode(@uc, PChar(ev.text.text), 1);
 334         keychr := Word(uc);
 335         if (keychr > 127) then keychr := Word(wchar2win(WideChar(keychr)));
 336         if (keychr > 0) and (assigned(fuiEventCB)) then
 337         begin
 338           fev := TFUIEvent.Create(TFUIEvent.TType.Key, TFUIEvent.TKind.SimpleChar);
 339           fev.ch := AnsiChar(keychr);
 340           fev.x := fuiMouseX;
 341           fev.y := fuiMouseY;
 342           fev.bstate := fuiButState;
 343           fev.kstate := fuiModState;
 344           fuiEventCB(fev);
 345           result := fev.eaten;
 346         end;
 347       end;
 348   end;
 349 end;
 350
 351
 352 begin
 353   initTimerIntr();
 354   fuiWinActive := fuiWinActive;
 355   fuiScrWdt := fuiScrWdt;
 356   fuiScrHgt := fuiScrHgt;
 357 end.