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, version 3 of the License ONLY.
   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 fui_events;
  18
  19 interface
  20
  21 uses
  22   SysUtils, Classes,
  23   SDL2;
  24
  25
  26 // ////////////////////////////////////////////////////////////////////////// //
  27 type
  28   TFUIEvent = packed record
  29   public
  30     // keyboard modifiers
  31     const
  32       ModCtrl = $0001;
  33       ModAlt = $0002;
  34       ModShift = $0004;
  35       ModHyper = $0008;
  36
  37     // mouse buttons
  38     const
  39       // both for but and for bstate
  40       None = 0;
  41       Left = $0001;
  42       Right = $0002;
  43       Middle = $0004;
  44       WheelUp = $0008;
  45       WheelDown = $0010;
  46
  47     // event types
  48     type
  49       TType = (Key, Mouse, User);
  50       TKind = (Release, Press, Motion, SimpleChar, Other);
  51       // SimpleChar: keyboard event with `ch`, but without `scan` (it is zero)
  52
  53     // event state
  54     type
  55       TState = (
  56         None, // or "mine"
  57         Sinking,
  58         Bubbling,
  59         Eaten,
  60         Cancelled
  61       );
  62
  63   private
  64     mType: TType; // event type: keyboard, mouse, etc...
  65     mKind: TKind; // motion, press, release
  66     mState: TState;
  67
  68     function getEaten (): Boolean; inline;
  69     function getCancelled (): Boolean; inline;
  70     function getNoState (): Boolean; inline;
  71     function getSinking (): Boolean; inline;
  72     function getBubbling (): Boolean; inline;
  73
  74   public
  75     x, y: Integer; // current mouse position
  76     dx, dy: Integer; // for wheel this is wheel motion, otherwise this is relative mouse motion
  77     bstate: Word; // button state BEFORE event (i.e. press/release modifications aren't done yet)
  78     kstate: Word; // keyboard state (see TFUIKeyEvent);
  79     // mouse events
  80     but: Word; // current pressed/released button, or 0 for motion
  81     // keyboard events
  82     scan: Word; // SDL_SCANCODE_XXX or 0 for character event
  83     ch: AnsiChar; // converted to 1251; can be #0
  84     // user tags
  85     itag: Integer;
  86     ptag: Pointer;
  87
  88   public
  89     // initial state is "None"
  90     constructor Create (atype: TType; akind: TKind);
  91
  92     // event type checkers
  93     function mouse (): Boolean; inline;
  94     function key (): Boolean; inline;
  95     function user (): Boolean; inline;
  96
  97     function press (): Boolean; inline;
  98     function release (): Boolean; inline;
  99     function motion (): Boolean; inline;
 100     function other (): Boolean; inline;
 101     function simpleChar (): Boolean; inline;
 102
 103     function alive (): Boolean; inline; // not eaten and not cancelled
 104     procedure eat (); inline;
 105     procedure cancel (); inline;
 106
 107     procedure setSinking (); inline;
 108     procedure setBubbling (); inline;
 109     procedure setMine (); inline;
 110
 111     // compares `scan` with `c`
 112     function isHot (c: AnsiChar): Boolean;
 113
 114   public
 115     property etype: TType read mType; // event type: keyboard, mouse, etc...
 116     property ekind: TKind read mKind; // motion, press, release
 117     property state: TState read mState;
 118
 119     property eaten: Boolean read getEaten;
 120     property cancelled: Boolean read getCancelled;
 121     property nostate: Boolean read getNoState;
 122     property mine: Boolean read getNoState;
 123     property sinking: Boolean read getSinking;
 124     property bubbling: Boolean read getBubbling;
 125   end;
 126
 127
 128 // ////////////////////////////////////////////////////////////////////////// //
 129 // call this on window deactivation, for example
 130 procedure fuiResetKMState (sendEvents: Boolean=true);
 131
 132
 133 // ////////////////////////////////////////////////////////////////////////// //
 134 // event handlers
 135 var
 136   fuiEventCB: procedure (var ev: TFUIEvent) = nil;
 137
 138
 139 // ////////////////////////////////////////////////////////////////////////// //
 140 function fuiMouseX (): Integer; inline;
 141 function fuiMouseY (): Integer; inline;
 142 function fuiButState (): Word; inline;
 143 function fuiModState (): Word; inline;
 144
 145 procedure fuiSetMouseX (v: Integer); inline;
 146 procedure fuiSetMouseY (v: Integer); inline;
 147 procedure fuiSetButState (v: Word); inline;
 148 procedure fuiSetModState (v: Word); inline;
 149
 150
 151 // ////////////////////////////////////////////////////////////////////////// //
 152 // any mods = 255: nothing was defined
 153 function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString;
 154
 155 operator = (constref ev: TFUIEvent; const s: AnsiString): Boolean;
 156 operator = (const s: AnsiString; constref ev: TFUIEvent): Boolean;
 157
 158
 159 implementation
 160
 161 var
 162   curButState: Word = 0;
 163   curModState: Word = 0;
 164   curMsX: Integer = 0;
 165   curMsY: Integer = 0;
 166
 167
 168 // ////////////////////////////////////////////////////////////////////////// //
 169 function locase1251 (ch: AnsiChar): AnsiChar; inline;
 170 begin
 171   if ch < #128 then
 172   begin
 173     if (ch >= 'A') and (ch <= 'Z') then Inc(ch, 32);
 174   end
 175   else
 176   begin
 177     if (ch >= #192) and (ch <= #223) then
 178     begin
 179       Inc(ch, 32);
 180     end
 181     else
 182     begin
 183       case ch of
 184         #168, #170, #175: Inc(ch, 16);
 185         #161, #178: Inc(ch);
 186       end;
 187     end;
 188   end;
 189   result := ch;
 190 end;
 191
 192
 193 function strEquCI (const s0, s1: AnsiString): Boolean;
 194 var
 195   f: Integer;
 196   c0, c1: AnsiChar;
 197 begin
 198   result := (Length(s0) = Length(s1));
 199   if result then
 200   begin
 201     for f := 1 to Length(s0) do
 202     begin
 203       c0 := s0[f];
 204       if (c0 >= 'a') and (c0 <= 'z') then Dec(c0, 32); // poor man's `toupper()`
 205       c1 := s1[f];
 206       if (c1 >= 'a') and (c1 <= 'z') then Dec(c1, 32); // poor man's `toupper()`
 207       if (c0 <> c1) then begin result := false; exit; end;
 208     end;
 209   end;
 210 end;
 211
 212
 213 // ////////////////////////////////////////////////////////////////////////// //
 214 function fuiMouseX (): Integer; inline; begin result := curMsX; end;
 215 function fuiMouseY (): Integer; inline; begin result := curMsY; end;
 216 function fuiButState (): Word; inline; begin result := curButState; end;
 217 function fuiModState (): Word; inline; begin result := curModState; end;
 218
 219 procedure fuiSetMouseX (v: Integer); inline; begin curMsX := v; end;
 220 procedure fuiSetMouseY (v: Integer); inline; begin curMsY := v; end;
 221 procedure fuiSetButState (v: Word); inline; begin curButState := v; end;
 222 procedure fuiSetModState (v: Word); inline; begin curModState := v; end;
 223
 224
 225 // ////////////////////////////////////////////////////////////////////////// //
 226 constructor TFUIEvent.Create (atype: TType; akind: TKind);
 227 begin
 228   FillChar(self, sizeof(self), 0);
 229   mType := atype;
 230   mKind := akind;
 231   mState := TState.None;
 232 end;
 233
 234 function TFUIEvent.mouse (): Boolean; inline; begin result := (mType = TType.Mouse); end;
 235 function TFUIEvent.key (): Boolean; inline; begin result := (mType = TType.Key); end;
 236 function TFUIEvent.user (): Boolean; inline; begin result := (mType = TType.User); end;
 237
 238 function TFUIEvent.press (): Boolean; inline; begin result := (mKind = TKind.Press); end;
 239 function TFUIEvent.release (): Boolean; inline; begin result := (mKind = TKind.Release); end;
 240 function TFUIEvent.motion (): Boolean; inline; begin result := (mKind = TKind.Motion); end;
 241 function TFUIEvent.other (): Boolean; inline; begin result := (mKind = TKind.Other); end;
 242 function TFUIEvent.simpleChar (): Boolean; inline; begin result := (mKind = TKind.SimpleChar); end;
 243
 244 function TFUIEvent.alive (): Boolean; inline; begin result := (mState <> TState.Cancelled) and (mState <> TState.Eaten); end;
 245 procedure TFUIEvent.eat (); inline; begin if (alive) then mState := TState.Eaten; end;
 246 procedure TFUIEvent.cancel (); inline; begin if (alive) then mState := TState.Cancelled; end;
 247 procedure TFUIEvent.setSinking (); inline; begin if (alive) then mState := TState.Sinking; end;
 248 procedure TFUIEvent.setBubbling (); inline; begin if (alive) then mState := TState.Bubbling; end;
 249 procedure TFUIEvent.setMine (); inline; begin if (alive) then mState := TState.None; end;
 250
 251
 252 function TFUIEvent.getEaten (): Boolean; inline; begin result := (mState = TState.Eaten); end;
 253 function TFUIEvent.getCancelled (): Boolean; inline; begin result := (mState = TState.Cancelled); end;
 254 function TFUIEvent.getNoState (): Boolean; inline; begin result := (mState = TState.None); end;
 255 function TFUIEvent.getSinking (): Boolean; inline; begin result := (mState = TState.Sinking); end;
 256 function TFUIEvent.getBubbling (): Boolean; inline; begin result := (mState = TState.Bubbling); end;
 257
 258
 259 function TFUIEvent.isHot (c: AnsiChar): Boolean;
 260 begin
 261   result := false;
 262   if (c = #0) then exit;
 263   if (not alive) or (not key) then exit;
 264   c := locase1251(c);
 265   if (simpleChar) then
 266   begin
 267     if (ch = #0) then exit;
 268     result := (locase1251(ch) = c);
 269   end
 270   else
 271   begin
 272     case scan of
 273       SDL_SCANCODE_A: result := (c = 'a') or (c = 'ô');
 274       SDL_SCANCODE_B: result := (c = 'b') or (c = 'è');
 275       SDL_SCANCODE_C: result := (c = 'c') or (c = 'ñ');
 276       SDL_SCANCODE_D: result := (c = 'd') or (c = 'â');
 277       SDL_SCANCODE_E: result := (c = 'e') or (c = 'ó');
 278       SDL_SCANCODE_F: result := (c = 'f') or (c = 'à');
 279       SDL_SCANCODE_G: result := (c = 'g') or (c = 'ï');
 280       SDL_SCANCODE_H: result := (c = 'h') or (c = 'ð');
 281       SDL_SCANCODE_I: result := (c = 'i') or (c = 'ø');
 282       SDL_SCANCODE_J: result := (c = 'j') or (c = 'î');
 283       SDL_SCANCODE_K: result := (c = 'k') or (c = 'ë');
 284       SDL_SCANCODE_L: result := (c = 'l') or (c = 'ä');
 285       SDL_SCANCODE_M: result := (c = 'm') or (c = 'ü');
 286       SDL_SCANCODE_N: result := (c = 'n') or (c = 'ò');
 287       SDL_SCANCODE_O: result := (c = 'o') or (c = 'ù');
 288       SDL_SCANCODE_P: result := (c = 'p') or (c = 'ç');
 289       SDL_SCANCODE_Q: result := (c = 'q') or (c = 'é');
 290       SDL_SCANCODE_R: result := (c = 'r') or (c = 'ê');
 291       SDL_SCANCODE_S: result := (c = 's') or (c = 'û');
 292       SDL_SCANCODE_T: result := (c = 't') or (c = 'å');
 293       SDL_SCANCODE_U: result := (c = 'u') or (c = 'ã');
 294       SDL_SCANCODE_V: result := (c = 'v') or (c = 'ì');
 295       SDL_SCANCODE_W: result := (c = 'w') or (c = 'ö');
 296       SDL_SCANCODE_X: result := (c = 'x') or (c = '÷');
 297       SDL_SCANCODE_Y: result := (c = 'y') or (c = 'í');
 298       SDL_SCANCODE_Z: result := (c = 'z') or (c = 'ÿ');
 299
 300       SDL_SCANCODE_1: result := (c = '1') or (c = '!');
 301       SDL_SCANCODE_2: result := (c = '2') or (c = '@');
 302       SDL_SCANCODE_3: result := (c = '3') or (c = '#');
 303       SDL_SCANCODE_4: result := (c = '4') or (c = '$');
 304       SDL_SCANCODE_5: result := (c = '5') or (c = '%');
 305       SDL_SCANCODE_6: result := (c = '6') or (c = '^');
 306       SDL_SCANCODE_7: result := (c = '7') or (c = '&');
 307       SDL_SCANCODE_8: result := (c = '8') or (c = '*');
 308       SDL_SCANCODE_9: result := (c = '9') or (c = '(');
 309       SDL_SCANCODE_0: result := (c = '0') or (c = ')');
 310
 311       SDL_SCANCODE_RETURN: result := (c = #13) or (c = #10);
 312       SDL_SCANCODE_ESCAPE: result := (c = #27);
 313       SDL_SCANCODE_BACKSPACE: result := (c = #8);
 314       SDL_SCANCODE_TAB: result := (c = #9);
 315       SDL_SCANCODE_SPACE: result := (c = ' ');
 316
 317       SDL_SCANCODE_MINUS: result := (c = '-');
 318       SDL_SCANCODE_EQUALS: result := (c = '=');
 319       SDL_SCANCODE_LEFTBRACKET: result := (c = '[') or (c = '{') or (c = 'õ');
 320       SDL_SCANCODE_RIGHTBRACKET: result := (c = ']') or (c = '}') or (c = 'ú');
 321       SDL_SCANCODE_BACKSLASH, SDL_SCANCODE_NONUSHASH: result := (c = '\') or (c = '|');
 322       SDL_SCANCODE_SEMICOLON: result := (c = ';') or (c = ':') or (c = 'æ');
 323       SDL_SCANCODE_APOSTROPHE: result := (c = '''') or (c = '"') or (c = 'ý');
 324       SDL_SCANCODE_GRAVE: result := (c = '`') or (c = '~') or (c = '¸');
 325       SDL_SCANCODE_COMMA: result := (c = ',') or (c = '<') or (c = 'á');
 326       SDL_SCANCODE_PERIOD: result := (c = '.') or (c = '>') or (c = '.') or (c = 'þ');
 327       SDL_SCANCODE_SLASH: result := (c = '/') or (c = '?') or (c = 'þ'); // ju: not a bug!
 328     end;
 329   end;
 330 end;
 331
 332
 333 // ////////////////////////////////////////////////////////////////////////// //
 334 // any mods = 255: nothing was defined
 335 function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString;
 336 var
 337   pos, epos: Integer;
 338 begin
 339   kmods := 255;
 340   mbuts := 255;
 341   pos := 1;
 342   //while (pos <= Length(s)) and (s[pos] <= ' ') do Inc(pos);
 343   if (pos < Length(s)) and ((s[pos] = '+') or (s[pos] = '-') or (s[pos] = '*')) then Inc(pos);
 344   while (pos <= Length(s)) do
 345   begin
 346     if (Length(s)-pos >= 1) and (s[pos+1] = '-') then
 347     begin
 348       case s[pos] of
 349         'C', 'c': begin if (kmods = 255) then kmods := 0; kmods := kmods or TFUIEvent.ModCtrl; Inc(pos, 2); continue; end;
 350         'M', 'm': begin if (kmods = 255) then kmods := 0; kmods := kmods or TFUIEvent.ModAlt; Inc(pos, 2); continue; end;
 351         'S', 's': begin if (kmods = 255) then kmods := 0; kmods := kmods or TFUIEvent.ModShift; Inc(pos, 2); continue; end;
 352       end;
 353       break;
 354     end;
 355     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
 356     begin
 357       case s[pos] of
 358         'L', 'l': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or TFUIEvent.Left; Inc(pos, 4); continue; end;
 359         'R', 'r': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or TFUIEvent.Right; Inc(pos, 4); continue; end;
 360         'M', 'm': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or TFUIEvent.Middle; Inc(pos, 4); continue; end;
 361       end;
 362       break;
 363     end;
 364     break;
 365   end;
 366   epos := Length(s)+1;
 367   while (epos > pos) and (s[epos-1] <= ' ') do Dec(epos);
 368   if (epos > pos) then result := Copy(s, pos, epos-pos) else result := '';
 369 end;
 370
 371
 372 operator = (const s: AnsiString; constref ev: TFUIEvent): Boolean;
 373 begin
 374   result := (ev = s);
 375 end;
 376
 377
 378 operator = (constref ev: TFUIEvent; const s: AnsiString): Boolean;
 379 var
 380   kmods: Byte = 255;
 381   mbuts: Byte = 255;
 382   kname: AnsiString;
 383   but: Integer = -1;
 384   modch: AnsiChar = ' ';
 385   kfound: Boolean;
 386   f: Integer;
 387 begin
 388   result := false;
 389   if (Length(s) = 0) then exit;
 390   // oops; i still want to compare dead events
 391   //if (not ev.alive) then exit; // dead events aren't equal to anything
 392   if (ev.user) then exit; // user events aren't equal to anything
 393   if (ev.simpleChar) or (ev.other) then exit; // those events are uncomparable for now
 394
 395        if (s[1] = '+') then begin if (not ev.press) then exit; modch := '+'; end
 396   else if (s[1] = '-') then begin if (not ev.release) then exit; modch := '-'; end
 397   else if (s[1] = '*') then begin if (not ev.motion) then exit; end
 398   else if (not ev.press) then exit;
 399
 400   kname := parseModKeys(s, kmods, mbuts);
 401   //if (ev.mouse) then writeln('compare: ', ev.mKind, ':', ev.mType, '; kstate=', ev.kstate, '; bstate=', ev.bstate, '; s=<', s, '>; kname=<', kname, '>; kmods=', kmods, '; mbuts=', mbuts);
 402   if (Length(kname) = 0) then exit; // some error occured
 403   if (strEquCI(kname, 'Enter')) then kname := 'RETURN';
 404
 405   if (mbuts = 255) then mbuts := 0;
 406   if (kmods = 255) then kmods := 0;
 407   if (ev.kstate <> kmods) then exit;
 408
 409        if (strEquCI(kname, 'LMB')) then but := TFUIEvent.Left
 410   else if (strEquCI(kname, 'RMB')) then but := TFUIEvent.Right
 411   else if (strEquCI(kname, 'MMB')) then but := TFUIEvent.Middle
 412   else if (strEquCI(kname, 'WheelUp')) or strEquCI(kname, 'WUP') then but := TFUIEvent.WheelUp
 413   else if (strEquCI(kname, 'WheelDown')) or strEquCI(kname, 'WDN') or strEquCI(kname, 'WDOWN') then but := TFUIEvent.WheelDown
 414   else if (strEquCI(kname, 'None')) then but := 0
 415   else
 416   begin
 417     // try keyboard
 418     if (not ev.key) then exit;
 419     if (strEquCI(kname, 'Empty')) or (strEquCI(kname, 'NoKey')) then
 420     begin
 421       kfound := (ev.scan = 0);
 422     end
 423     else
 424     begin
 425       kfound := false;
 426       for f := 1 to SDL_NUM_SCANCODES-1 do
 427       begin
 428         if (strEquCI(kname, SDL_GetScancodeName(f))) then begin kfound := (ev.scan = f); break; end;
 429       end;
 430     end;
 431     if (not kfound) then exit;
 432   end;
 433   //writeln('  scan=', ev.scan, '; found=', kfound);
 434
 435   if (but <> -1) and (not ev.mouse) then exit; // mouse kname, but not mouse event
 436
 437   // fix mouse buttons
 438   if (ev.mouse) then
 439   begin
 440     if (modch = '-') then mbuts := mbuts or but else if (modch = '+') then mbuts := mbuts and (not but);
 441     result := (ev.bstate = mbuts) and (ev.but = but);
 442   end
 443   else
 444   begin
 445     result := (ev.bstate = mbuts);
 446   end;
 447 end;
 448
 449
 450 // ////////////////////////////////////////////////////////////////////////// //
 451 procedure fuiResetKMState (sendEvents: Boolean=true);
 452 var
 453   mask: Word;
 454   ev: TFUIEvent;
 455 begin
 456   // generate mouse release events
 457   if (curButState <> 0) then
 458   begin
 459     if (sendEvents) then
 460     begin
 461       mask := 1;
 462       while (mask <> 0) do
 463       begin
 464         // checked each time, 'cause `evMouseCB` can be changed from the handler
 465         if ((curButState and mask) <> 0) and (assigned(fuiEventCB)) then
 466         begin
 467           ev := TFUIEvent.Create(TFUIEvent.TType.Mouse, TFUIEvent.TKind.Release);
 468           ev.x := curMsX;
 469           ev.y := curMsY;
 470           ev.but := mask;
 471           ev.bstate := curButState;
 472           ev.kstate := curModState;
 473           curButState := curButState and (not mask);
 474           fuiEventCB(ev);
 475         end;
 476         mask := mask shl 1;
 477       end;
 478     end;
 479     curButState := 0;
 480   end;
 481
 482   // generate modifier release events
 483   if (curModState <> 0) then
 484   begin
 485     if (sendEvents) then
 486     begin
 487       mask := 1;
 488       while (mask <= 8) do
 489       begin
 490         // checked each time, 'cause `evMouseCB` can be changed from the handler
 491         if ((curModState and mask) <> 0) and (assigned(fuiEventCB)) then
 492         begin
 493           ev := TFUIEvent.Create(TFUIEvent.TType.Key, TFUIEvent.TKind.Release);
 494           case mask of
 495             TFUIEvent.ModCtrl: begin ev.scan := SDL_SCANCODE_LCTRL; {kev.sym := SDLK_LCTRL;}{arbitrary} end;
 496             TFUIEvent.ModAlt: begin ev.scan := SDL_SCANCODE_LALT; {kev.sym := SDLK_LALT;}{arbitrary} end;
 497             TFUIEvent.ModShift: begin ev.scan := SDL_SCANCODE_LSHIFT; {kev.sym := SDLK_LSHIFT;}{arbitrary} end;
 498             TFUIEvent.ModHyper: begin ev.scan := SDL_SCANCODE_LGUI; {kev.sym := SDLK_LGUI;}{arbitrary} end;
 499             else assert(false);
 500           end;
 501           ev.x := curMsX;
 502           ev.y := curMsY;
 503           //mev.bstate := 0{curMsButState}; // anyway
 504           ev.kstate := curModState;
 505           curModState := curModState and (not mask);
 506           fuiEventCB(ev);
 507         end;
 508         mask := mask shl 1;
 509       end;
 510     end;
 511     curModState := 0;
 512   end;
 513 end;
 514
 515
 516 end.