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   mev: THMouseEvent;
 186   kev: THKeyEvent;
 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 THMouseEvent.Left;
 195       SDL_BUTTON_MIDDLE: result := result or THMouseEvent.Middle;
 196       SDL_BUTTON_RIGHT: result := result or THMouseEvent.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         FillChar(kev, sizeof(kev), 0);
 230         kev.intrInit();
 231         if (ev.type_ = SDL_KEYDOWN) then kev.kind := THKeyEvent.TKind.Press else kev.kind := THKeyEvent.TKind.Release;
 232         kev.scan := ev.key.keysym.scancode;
 233         //kev.sym := ev.key.keysym.sym;
 234
 235         if (kev.scan = SDL_SCANCODE_RCTRL) then kev.scan := SDL_SCANCODE_LCTRL;
 236         if (kev.scan = SDL_SCANCODE_RALT) then kev.scan := SDL_SCANCODE_LALT;
 237         if (kev.scan = SDL_SCANCODE_RSHIFT) then kev.scan := SDL_SCANCODE_LSHIFT;
 238         if (kev.scan = SDL_SCANCODE_RGUI) then kev.scan := SDL_SCANCODE_LGUI;
 239
 240         {
 241         if (kev.sym = SDLK_RCTRL) then kev.sym := SDLK_LCTRL;
 242         if (kev.sym = SDLK_RALT) then kev.sym := SDLK_LALT;
 243         if (kev.sym = SDLK_RSHIFT) then kev.sym := SDLK_LSHIFT;
 244         if (kev.sym = SDLK_RGUI) then kev.sym := SDLK_LGUI;
 245         }
 246
 247         kev.x := fuiMouseX;
 248         kev.y := fuiMouseY;
 249         kev.bstate := fuiButState;
 250         kev.kstate := fuiModState;
 251
 252         case kev.scan of
 253           SDL_SCANCODE_LCTRL: if (kev.press) then fuiSetModState(fuiModState or THKeyEvent.ModCtrl) else fuiSetModState(fuiModState and (not THKeyEvent.ModCtrl));
 254           SDL_SCANCODE_LALT: if (kev.press) then fuiSetModState(fuiModState or THKeyEvent.ModAlt) else fuiSetModState(fuiModState and (not THKeyEvent.ModAlt));
 255           SDL_SCANCODE_LSHIFT: if (kev.press) then fuiSetModState(fuiModState or THKeyEvent.ModShift) else fuiSetModState(fuiModState and (not THKeyEvent.ModShift));
 256         end;
 257
 258         if assigned(evKeyCB) then
 259         begin
 260           evKeyCB(kev);
 261           result := kev.eaten;
 262         end;
 263       end;
 264
 265     SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP:
 266       begin
 267         FillChar(mev, sizeof(mev), 0);
 268         mev.intrInit();
 269         if (ev.type_ = SDL_MOUSEBUTTONDOWN) then mev.kind := THMouseEvent.TKind.Press else mev.kind := THMouseEvent.TKind.Release;
 270         mev.dx := ev.button.x-fuiMouseX;
 271         mev.dy := ev.button.y-fuiMouseY;
 272         fuiSetMouseX(ev.button.x);
 273         fuiSetMouseY(ev.button.y);
 274         mev.but := buildBut(ev.button.button);
 275         mev.x := fuiMouseX;
 276         mev.y := fuiMouseY;
 277         mev.bstate := fuiButState;
 278         mev.kstate := fuiModState;
 279         if (mev.but <> 0) then
 280         begin
 281           // ev.button.clicks: Byte
 282           if (ev.type_ = SDL_MOUSEBUTTONDOWN) then fuiSetButState(fuiButState or mev.but) else fuiSetButState(fuiButState and (not mev.but));
 283           if assigned(evMouseCB) then
 284           begin
 285             evMouseCB(mev);
 286             result := mev.eaten;
 287           end;
 288         end;
 289       end;
 290     SDL_MOUSEWHEEL:
 291       begin
 292         if (ev.wheel.y <> 0) then
 293         begin
 294           FillChar(mev, sizeof(mev), 0);
 295           mev.intrInit();
 296           mev.kind := THMouseEvent.TKind.Press;
 297           mev.dx := 0;
 298           mev.dy := ev.wheel.y;
 299           if (ev.wheel.y < 0) then mev.but := THMouseEvent.WheelUp else mev.but := THMouseEvent.WheelDown;
 300           mev.x := fuiMouseX;
 301           mev.y := fuiMouseY;
 302           mev.bstate := fuiButState;
 303           mev.kstate := fuiModState;
 304           if assigned(evMouseCB) then
 305           begin
 306             evMouseCB(mev);
 307             result := mev.eaten;
 308           end;
 309         end;
 310       end;
 311     SDL_MOUSEMOTION:
 312       begin
 313         FillChar(mev, sizeof(mev), 0);
 314         mev.intrInit();
 315         mev.kind := THMouseEvent.TKind.Motion;
 316         mev.dx := ev.button.x-fuiMouseX;
 317         mev.dy := ev.button.y-fuiMouseY;
 318         fuiSetMouseX(ev.button.x);
 319         fuiSetMouseY(ev.button.y);
 320         mev.but := 0;
 321         mev.x := fuiMouseX;
 322         mev.y := fuiMouseY;
 323         mev.bstate := fuiButState;
 324         mev.kstate := fuiModState;
 325         if assigned(evMouseCB) then
 326         begin
 327           evMouseCB(mev);
 328           result := mev.eaten;
 329         end;
 330       end;
 331
 332     SDL_TEXTINPUT:
 333       if ((fuiModState and (not THKeyEvent.ModShift)) = 0) then
 334       begin
 335         Utf8ToUnicode(@uc, PChar(ev.text.text), 1);
 336         keychr := Word(uc);
 337         if (keychr > 127) then keychr := Word(wchar2win(WideChar(keychr)));
 338         if (keychr > 0) and assigned(evKeyCB) then
 339         begin
 340           FillChar(kev, sizeof(kev), 0);
 341           kev.intrInit();
 342           kev.kind := THKeyEvent.TKind.Press;
 343           kev.scan := 0;
 344           kev.ch := AnsiChar(keychr);
 345           kev.x := fuiMouseX;
 346           kev.y := fuiMouseY;
 347           kev.bstate := fuiButState;
 348           kev.kstate := fuiModState;
 349           evKeyCB(kev);
 350           result := kev.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.