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