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