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