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