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