src/flexui/fui_events.pas

   1 (* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
   2  * Understanding is not required. Only obedience.
   3  *
   4  * This program is free software: you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation, either version 3 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program. If not, see <http://www.gnu.org/licenses/>.
  16  *)
  17 {$INCLUDE ../shared/a_modes.inc}
  18 unit fui_events;
  19
  20 interface
  21
  22 uses
  23   SysUtils, Classes,
  24   SDL2;
  25
  26
  27 // ////////////////////////////////////////////////////////////////////////// //
  28 type
  29   TFUIMouseEvent = record
  30   public
  31     const
  32       // both for but and for bstate
  33       None = 0;
  34       Left = $0001;
  35       Right = $0002;
  36       Middle = $0004;
  37       WheelUp = $0008;
  38       WheelDown = $0010;
  39
  40     // event types
  41     type
  42       TKind = (Release, Press, Motion);
  43
  44   private
  45     mEaten: Boolean;
  46     mCancelled: Boolean;
  47
  48   public
  49     kind: TKind; // motion, press, release
  50     x, y: Integer; // current mouse position
  51     dx, dy: Integer; // for wheel this is wheel motion, otherwise this is relative mouse motion
  52     but: Word; // current pressed/released button, or 0 for motion
  53     bstate: Word; // button state BEFORE event (i.e. press/release modifications aren't done yet)
  54     kstate: Word; // keyboard state (see TFUIKeyEvent);
  55
  56   public
  57     procedure intrInit (); inline; // init hidden fields
  58
  59     function press (): Boolean; inline;
  60     function release (): Boolean; inline;
  61     function motion (): Boolean; inline;
  62     function isAlive (): Boolean; inline;
  63     procedure eat (); inline;
  64     procedure cancel (); inline;
  65
  66   public
  67     property eaten: Boolean read mEaten;
  68     property cancelled: Boolean read mCancelled;
  69     property alive: Boolean read isAlive; // not eaten and not cancelled
  70   end;
  71
  72   TFUIKeyEvent = record
  73   public
  74     const
  75       // modifiers
  76       ModCtrl = $0001;
  77       ModAlt = $0002;
  78       ModShift = $0004;
  79       ModHyper = $0008;
  80
  81     // event types
  82     type
  83       TKind = (Release, Press);
  84
  85   private
  86     mEaten: Boolean;
  87     mCancelled: Boolean;
  88
  89   public
  90     kind: TKind;
  91     scan: Word; // SDL_SCANCODE_XXX or 0 for character event
  92     //sym: LongWord; // SDLK_XXX
  93     ch: AnsiChar; // converted to 1251; can be #0
  94     x, y: Integer; // current mouse position
  95     bstate: Word; // button state
  96     kstate: Word; // keyboard state BEFORE event (i.e. press/release modifications aren't done yet)
  97
  98   public
  99     procedure intrInit (); inline; // init hidden fields
 100
 101     function press (): Boolean; inline;
 102     function release (): Boolean; inline;
 103     function isAlive (): Boolean; inline;
 104     procedure eat (); inline;
 105     procedure cancel (); inline;
 106
 107     function isHot (c: AnsiChar): Boolean;
 108
 109   public
 110     property eaten: Boolean read mEaten;
 111     property cancelled: Boolean read mCancelled;
 112     property alive: Boolean read isAlive; // not eaten and not cancelled
 113   end;
 114
 115
 116 // ////////////////////////////////////////////////////////////////////////// //
 117 // call this on window deactivation, for example
 118 procedure fuiResetKMState (sendEvents: Boolean=true);
 119
 120
 121 // ////////////////////////////////////////////////////////////////////////// //
 122 // event handlers
 123 var
 124   evMouseCB: procedure (var ev: TFUIMouseEvent) = nil;
 125   evKeyCB: procedure (var ev: TFUIKeyEvent) = nil;
 126
 127
 128 // ////////////////////////////////////////////////////////////////////////// //
 129 function fuiMouseX (): Integer; inline;
 130 function fuiMouseY (): Integer; inline;
 131 function fuiButState (): Word; inline;
 132 function fuiModState (): Word; inline;
 133
 134 procedure fuiSetMouseX (v: Integer); inline;
 135 procedure fuiSetMouseY (v: Integer); inline;
 136 procedure fuiSetButState (v: Word); inline;
 137 procedure fuiSetModState (v: Word); inline;
 138
 139
 140 // ////////////////////////////////////////////////////////////////////////// //
 141 // any mods = 255: nothing was defined
 142 function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString;
 143
 144 operator = (constref ev: TFUIKeyEvent; const s: AnsiString): Boolean;
 145 operator = (const s: AnsiString; constref ev: TFUIKeyEvent): Boolean;
 146
 147 operator = (constref ev: TFUIMouseEvent; const s: AnsiString): Boolean;
 148 operator = (const s: AnsiString; constref ev: TFUIMouseEvent): Boolean;
 149
 150
 151 implementation
 152
 153 var
 154   curButState: Word = 0;
 155   curModState: Word = 0;
 156   curMsX: Integer = 0;
 157   curMsY: Integer = 0;
 158
 159
 160 // ////////////////////////////////////////////////////////////////////////// //
 161 function strEquCI (const s0, s1: AnsiString): Boolean;
 162 var
 163   f: Integer;
 164   c0, c1: AnsiChar;
 165 begin
 166   result := (Length(s0) = Length(s1));
 167   if result then
 168   begin
 169     for f := 1 to Length(s0) do
 170     begin
 171       c0 := s0[f];
 172       if (c0 >= 'a') and (c0 <= 'z') then Dec(c0, 32); // poor man's `toupper()`
 173       c1 := s1[f];
 174       if (c1 >= 'a') and (c1 <= 'z') then Dec(c1, 32); // poor man's `toupper()`
 175       if (c0 <> c1) then begin result := false; exit; end;
 176     end;
 177   end;
 178 end;
 179
 180
 181 // ////////////////////////////////////////////////////////////////////////// //
 182 function fuiMouseX (): Integer; inline; begin result := curMsX; end;
 183 function fuiMouseY (): Integer; inline; begin result := curMsY; end;
 184 function fuiButState (): Word; inline; begin result := curButState; end;
 185 function fuiModState (): Word; inline; begin result := curModState; end;
 186
 187 procedure fuiSetMouseX (v: Integer); inline; begin curMsX := v; end;
 188 procedure fuiSetMouseY (v: Integer); inline; begin curMsY := v; end;
 189 procedure fuiSetButState (v: Word); inline; begin curButState := v; end;
 190 procedure fuiSetModState (v: Word); inline; begin curModState := v; end;
 191
 192
 193 // ////////////////////////////////////////////////////////////////////////// //
 194 procedure TFUIMouseEvent.intrInit (); inline; begin mEaten := false; mCancelled := false; end;
 195 function TFUIMouseEvent.press (): Boolean; inline; begin result := (kind = TKind.Press); end;
 196 function TFUIMouseEvent.release (): Boolean; inline; begin result := (kind = TKind.Release); end;
 197 function TFUIMouseEvent.motion (): Boolean; inline; begin result := (kind = TKind.Motion); end;
 198 function TFUIMouseEvent.isAlive (): Boolean; inline; begin result := (not mEaten) and (not mCancelled); end;
 199 procedure TFUIMouseEvent.eat (); inline; begin mEaten := true; end;
 200 procedure TFUIMouseEvent.cancel (); inline; begin mCancelled := true; end;
 201
 202 procedure TFUIKeyEvent.intrInit (); inline; begin mEaten := false; mCancelled := false; ch := #0; scan := 0; end;
 203 function TFUIKeyEvent.press (): Boolean; inline; begin result := (kind = TKind.Press); end;
 204 function TFUIKeyEvent.release (): Boolean; inline; begin result := (kind = TKind.Release); end;
 205 function TFUIKeyEvent.isAlive (): Boolean; inline; begin result := (not mEaten) and (not mCancelled); end;
 206 procedure TFUIKeyEvent.eat (); inline; begin mEaten := true; end;
 207 procedure TFUIKeyEvent.cancel (); inline; begin mCancelled := true; end;
 208
 209 function TFUIKeyEvent.isHot (c: AnsiChar): Boolean;
 210 begin
 211   if (c = #0) or (scan = 0) or (scan = $FFFF) then begin result := false; exit; end;
 212   case scan of
 213     SDL_SCANCODE_A: result := (c = 'A') or (c = 'a') or (c = 'Ô') or (c = 'ô');
 214     SDL_SCANCODE_B: result := (c = 'B') or (c = 'b') or (c = 'È') or (c = 'è');
 215     SDL_SCANCODE_C: result := (c = 'C') or (c = 'c') or (c = 'Ñ') or (c = 'ñ');
 216     SDL_SCANCODE_D: result := (c = 'D') or (c = 'd') or (c = 'Â') or (c = 'â');
 217     SDL_SCANCODE_E: result := (c = 'E') or (c = 'e') or (c = 'Ó') or (c = 'ó');
 218     SDL_SCANCODE_F: result := (c = 'F') or (c = 'f') or (c = 'À') or (c = 'à');
 219     SDL_SCANCODE_G: result := (c = 'G') or (c = 'g') or (c = 'Ï') or (c = 'ï');
 220     SDL_SCANCODE_H: result := (c = 'H') or (c = 'h') or (c = 'Ð') or (c = 'ð');
 221     SDL_SCANCODE_I: result := (c = 'I') or (c = 'i') or (c = 'Ø') or (c = 'ø');
 222     SDL_SCANCODE_J: result := (c = 'J') or (c = 'j') or (c = 'Î') or (c = 'î');
 223     SDL_SCANCODE_K: result := (c = 'K') or (c = 'k') or (c = 'Ë') or (c = 'ë');
 224     SDL_SCANCODE_L: result := (c = 'L') or (c = 'l') or (c = 'Ä') or (c = 'ä');
 225     SDL_SCANCODE_M: result := (c = 'M') or (c = 'm') or (c = 'Ü') or (c = 'ü');
 226     SDL_SCANCODE_N: result := (c = 'N') or (c = 'n') or (c = 'Ò') or (c = 'ò');
 227     SDL_SCANCODE_O: result := (c = 'O') or (c = 'o') or (c = 'Ù') or (c = 'ù');
 228     SDL_SCANCODE_P: result := (c = 'P') or (c = 'p') or (c = 'Ç') or (c = 'ç');
 229     SDL_SCANCODE_Q: result := (c = 'Q') or (c = 'q') or (c = 'É') or (c = 'é');
 230     SDL_SCANCODE_R: result := (c = 'R') or (c = 'r') or (c = 'Ê') or (c = 'ê');
 231     SDL_SCANCODE_S: result := (c = 'S') or (c = 's') or (c = 'Û') or (c = 'û');
 232     SDL_SCANCODE_T: result := (c = 'T') or (c = 't') or (c = 'Å') or (c = 'å');
 233     SDL_SCANCODE_U: result := (c = 'U') or (c = 'u') or (c = 'Ã') or (c = 'ã');
 234     SDL_SCANCODE_V: result := (c = 'V') or (c = 'v') or (c = 'Ì') or (c = 'ì');
 235     SDL_SCANCODE_W: result := (c = 'W') or (c = 'w') or (c = 'Ö') or (c = 'ö');
 236     SDL_SCANCODE_X: result := (c = 'X') or (c = 'x') or (c = '×') or (c = '÷');
 237     SDL_SCANCODE_Y: result := (c = 'Y') or (c = 'y') or (c = 'Í') or (c = 'í');
 238     SDL_SCANCODE_Z: result := (c = 'Z') or (c = 'z') or (c = 'ß') or (c = 'ÿ');
 239
 240     SDL_SCANCODE_1: result := (c = '1') or (c = '!');
 241     SDL_SCANCODE_2: result := (c = '2') or (c = '@');
 242     SDL_SCANCODE_3: result := (c = '3') or (c = '#');
 243     SDL_SCANCODE_4: result := (c = '4') or (c = '$');
 244     SDL_SCANCODE_5: result := (c = '5') or (c = '%');
 245     SDL_SCANCODE_6: result := (c = '6') or (c = '^');
 246     SDL_SCANCODE_7: result := (c = '7') or (c = '&');
 247     SDL_SCANCODE_8: result := (c = '8') or (c = '*');
 248     SDL_SCANCODE_9: result := (c = '9') or (c = '(');
 249     SDL_SCANCODE_0: result := (c = '0') or (c = ')');
 250
 251     SDL_SCANCODE_RETURN: result := (c = #13) or (c = #10);
 252     SDL_SCANCODE_ESCAPE: result := (c = #27);
 253     SDL_SCANCODE_BACKSPACE: result := (c = #8);
 254     SDL_SCANCODE_TAB: result := (c = #9);
 255     SDL_SCANCODE_SPACE: result := (c = ' ');
 256
 257     SDL_SCANCODE_MINUS: result := (c = '-');
 258     SDL_SCANCODE_EQUALS: result := (c = '=');
 259     SDL_SCANCODE_LEFTBRACKET: result := (c = '[') or (c = '{');
 260     SDL_SCANCODE_RIGHTBRACKET: result := (c = ']') or (c = '}');
 261     SDL_SCANCODE_BACKSLASH, SDL_SCANCODE_NONUSHASH: result := (c = '\') or (c = '|');
 262     SDL_SCANCODE_SEMICOLON: result := (c = ';') or (c = ':');
 263     SDL_SCANCODE_APOSTROPHE: result := (c = '''') or (c = '"');
 264     SDL_SCANCODE_GRAVE: result := (c = '`') or (c = '~');
 265     SDL_SCANCODE_COMMA: result := (c = ',') or (c = '<');
 266     SDL_SCANCODE_PERIOD: result := (c = '.') or (c = '>');
 267     SDL_SCANCODE_SLASH: result := (c = '/') or (c = '?');
 268
 269     else result := false;
 270   end;
 271 end;
 272
 273
 274 // ////////////////////////////////////////////////////////////////////////// //
 275 // any mods = 255: nothing was defined
 276 function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString;
 277 var
 278   pos, epos: Integer;
 279 begin
 280   kmods := 255;
 281   mbuts := 255;
 282   pos := 1;
 283   //while (pos <= Length(s)) and (s[pos] <= ' ') do Inc(pos);
 284   if (pos < Length(s)) and ((s[pos] = '+') or (s[pos] = '-') or (s[pos] = '*')) then Inc(pos);
 285   while (pos <= Length(s)) do
 286   begin
 287     if (Length(s)-pos >= 1) and (s[pos+1] = '-') then
 288     begin
 289       case s[pos] of
 290         'C', 'c': begin if (kmods = 255) then kmods := 0; kmods := kmods or TFUIKeyEvent.ModCtrl; Inc(pos, 2); continue; end;
 291         'M', 'm': begin if (kmods = 255) then kmods := 0; kmods := kmods or TFUIKeyEvent.ModAlt; Inc(pos, 2); continue; end;
 292         'S', 's': begin if (kmods = 255) then kmods := 0; kmods := kmods or TFUIKeyEvent.ModShift; Inc(pos, 2); continue; end;
 293       end;
 294       break;
 295     end;
 296     if (Length(s)-pos >= 3) and (s[pos+3] = '-') and ((s[pos+1] = 'M') or (s[pos+1] = 'm')) and ((s[pos+2] = 'B') or (s[pos+2] = 'b')) then
 297     begin
 298       case s[pos] of
 299         'L', 'l': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or TFUIMouseEvent.Left; Inc(pos, 4); continue; end;
 300         'R', 'r': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or TFUIMouseEvent.Right; Inc(pos, 4); continue; end;
 301         'M', 'm': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or TFUIMouseEvent.Middle; Inc(pos, 4); continue; end;
 302       end;
 303       break;
 304     end;
 305     break;
 306   end;
 307   epos := Length(s)+1;
 308   while (epos > pos) and (s[epos-1] <= ' ') do Dec(epos);
 309   if (epos > pos) then result := Copy(s, pos, epos-pos) else result := '';
 310 end;
 311
 312
 313 operator = (constref ev: TFUIKeyEvent; const s: AnsiString): Boolean;
 314 var
 315   f: Integer;
 316   kmods: Byte = 255;
 317   mbuts: Byte = 255;
 318   kname: AnsiString;
 319 begin
 320   result := false;
 321   if (Length(s) > 0) then
 322   begin
 323          if (s[1] = '+') then begin if (not ev.press) then exit; end
 324     else if (s[1] = '-') then begin if (not ev.release) then exit; end
 325     else if (s[1] = '*') then begin end
 326     else if (not ev.press) then exit;
 327   end;
 328   kname := parseModKeys(s, kmods, mbuts);
 329   if (kmods = 255) then kmods := 0;
 330   if (ev.kstate <> kmods) then exit;
 331   if (mbuts <> 255) and (ev.bstate <> mbuts) then exit;
 332
 333   if (strEquCI(kname, 'Enter')) then kname := 'RETURN';
 334
 335   for f := 0 to SDL_NUM_SCANCODES-1 do
 336   begin
 337     if strEquCI(kname, SDL_GetScancodeName(f)) then
 338     begin
 339       result := (ev.scan = f);
 340       exit;
 341     end;
 342   end;
 343 end;
 344
 345
 346 operator = (const s: AnsiString; constref ev: TFUIKeyEvent): Boolean;
 347 begin
 348   result := (ev = s);
 349 end;
 350
 351
 352 operator = (constref ev: TFUIMouseEvent; const s: AnsiString): Boolean;
 353 var
 354   kmods: Byte = 255;
 355   mbuts: Byte = 255;
 356   kname: AnsiString;
 357   but: Integer = -1;
 358   modch: AnsiChar = ' ';
 359 begin
 360   result := false;
 361
 362   if (Length(s) > 0) then
 363   begin
 364          if (s[1] = '+') then begin if (not ev.press) then exit; modch := '+'; end
 365     else if (s[1] = '-') then begin if (not ev.release) then exit; modch := '-'; end
 366     else if (s[1] = '*') then begin if (not ev.motion) then exit; end
 367     else if (not ev.press) then exit;
 368   end;
 369
 370   kname := parseModKeys(s, kmods, mbuts);
 371        if strEquCI(kname, 'LMB') then but := TFUIMouseEvent.Left
 372   else if strEquCI(kname, 'RMB') then but := TFUIMouseEvent.Right
 373   else if strEquCI(kname, 'MMB') then but := TFUIMouseEvent.Middle
 374   else if strEquCI(kname, 'WheelUp') or strEquCI(kname, 'WUP') then but := TFUIMouseEvent.WheelUp
 375   else if strEquCI(kname, 'WheelDown') or strEquCI(kname, 'WDN') or strEquCI(kname, 'WDOWN') then but := TFUIMouseEvent.WheelDown
 376   else if strEquCI(kname, 'None') then but := 0
 377   else exit;
 378
 379   if (mbuts = 255) then mbuts := 0;
 380   if (kmods = 255) then kmods := 0;
 381   if (ev.kstate <> kmods) then exit;
 382   if (modch = '-') then mbuts := mbuts or but else if (modch = '+') then mbuts := mbuts and (not but);
 383
 384   result := (ev.bstate = mbuts) and (ev.but = but);
 385 end;
 386
 387
 388 operator = (const s: AnsiString; constref ev: TFUIMouseEvent): Boolean;
 389 begin
 390   result := (ev = s);
 391 end;
 392
 393
 394 // ////////////////////////////////////////////////////////////////////////// //
 395 procedure fuiResetKMState (sendEvents: Boolean=true);
 396 var
 397   mask: Word;
 398   mev: TFUIMouseEvent;
 399   kev: TFUIKeyEvent;
 400 begin
 401   // generate mouse release events
 402   if (curButState <> 0) then
 403   begin
 404     if sendEvents then
 405     begin
 406       mask := 1;
 407       while (mask <> 0) do
 408       begin
 409         // checked each time, 'cause `evMouseCB` can be changed from the handler
 410         if ((curButState and mask) <> 0) and assigned(evMouseCB) then
 411         begin
 412           FillChar(mev, sizeof(mev), 0);
 413           mev.intrInit();
 414           mev.kind := mev.TKind.Release;
 415           mev.x := curMsX;
 416           mev.y := curMsY;
 417           mev.dx := 0;
 418           mev.dy := 0;
 419           mev.but := mask;
 420           mev.bstate := curButState;
 421           mev.kstate := curModState;
 422           curButState := curButState and (not mask);
 423           evMouseCB(mev);
 424         end;
 425         mask := mask shl 1;
 426       end;
 427     end;
 428     curButState := 0;
 429   end;
 430
 431   // generate modifier release events
 432   if (curModState <> 0) then
 433   begin
 434     if sendEvents then
 435     begin
 436       mask := 1;
 437       while (mask <= 8) do
 438       begin
 439         // checked each time, 'cause `evMouseCB` can be changed from the handler
 440         if ((curModState and mask) <> 0) and assigned(evKeyCB) then
 441         begin
 442           FillChar(kev, sizeof(kev), 0);
 443           kev.intrInit();
 444           kev.kind := kev.TKind.Release;
 445           case mask of
 446             TFUIKeyEvent.ModCtrl: begin kev.scan := SDL_SCANCODE_LCTRL; {kev.sym := SDLK_LCTRL;}{arbitrary} end;
 447             TFUIKeyEvent.ModAlt: begin kev.scan := SDL_SCANCODE_LALT; {kev.sym := SDLK_LALT;}{arbitrary} end;
 448             TFUIKeyEvent.ModShift: begin kev.scan := SDL_SCANCODE_LSHIFT; {kev.sym := SDLK_LSHIFT;}{arbitrary} end;
 449             TFUIKeyEvent.ModHyper: begin kev.scan := SDL_SCANCODE_LGUI; {kev.sym := SDLK_LGUI;}{arbitrary} end;
 450             else assert(false);
 451           end;
 452           kev.x := curMsX;
 453           kev.y := curMsY;
 454           mev.bstate := 0{curMsButState}; // anyway
 455           mev.kstate := curModState;
 456           curModState := curModState and (not mask);
 457           evKeyCB(kev);
 458         end;
 459         mask := mask shl 1;
 460       end;
 461     end;
 462     curModState := 0;
 463   end;
 464 end;
 465
 466
 467 end.