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