836ec1417431ed7cf77ff49aa627f5d0878d2a10
1 (* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
2 * Understanding is not required. Only obedience.
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.
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.
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/>.
16 {$INCLUDE ../shared/a_modes.inc}
20 {$FATAL SDL2 required for flexui fui_events}
30 // ////////////////////////////////////////////////////////////////////////// //
32 TFUIEvent
= packed record
43 // both for but and for bstate
53 TType
= (Key
, Mouse
, User
);
54 TKind
= (Release
, Press
, Motion
, SimpleChar
, Other
);
55 // SimpleChar: keyboard event with `ch`, but without `scan` (it is zero)
68 mType
: TType
; // event type: keyboard, mouse, etc...
69 mKind
: TKind
; // motion, press, release
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;
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);
84 but
: Word; // current pressed/released button, or 0 for motion
86 scan
: Word; // SDL_SCANCODE_XXX or 0 for character event
87 ch
: AnsiChar; // converted to 1251; can be #0
93 // initial state is "None"
94 constructor Create (atype
: TType
; akind
: TKind
);
96 // event type checkers
97 function mouse (): Boolean; inline;
98 function key (): Boolean; inline;
99 function user (): Boolean; inline;
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;
107 function alive (): Boolean; inline; // not eaten and not cancelled
108 procedure eat (); inline;
109 procedure cancel (); inline;
111 procedure setSinking (); inline;
112 procedure setBubbling (); inline;
113 procedure setMine (); inline;
115 // compares `scan` with `c`
116 function isHot (c
: AnsiChar): Boolean;
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
;
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
;
132 // ////////////////////////////////////////////////////////////////////////// //
133 // call this on window deactivation, for example
134 procedure fuiResetKMState (sendEvents
: Boolean=true);
137 // ////////////////////////////////////////////////////////////////////////// //
140 fuiEventCB
: procedure (var ev
: TFUIEvent
) = nil;
143 // ////////////////////////////////////////////////////////////////////////// //
144 function fuiMouseX (): Integer; inline;
145 function fuiMouseY (): Integer; inline;
146 function fuiButState (): Word; inline;
147 function fuiModState (): Word; inline;
149 procedure fuiSetMouseX (v
: Integer); inline;
150 procedure fuiSetMouseY (v
: Integer); inline;
151 procedure fuiSetButState (v
: Word); inline;
152 procedure fuiSetModState (v
: Word); inline;
155 // ////////////////////////////////////////////////////////////////////////// //
156 // any mods = 255: nothing was defined
157 function parseModKeys (const s
: AnsiString; out kmods
: Byte; out mbuts
: Byte): AnsiString;
159 operator
= (constref ev
: TFUIEvent
; const s
: AnsiString): Boolean;
160 operator
= (const s
: AnsiString; constref ev
: TFUIEvent
): Boolean;
166 curButState
: Word = 0;
167 curModState
: Word = 0;
172 // ////////////////////////////////////////////////////////////////////////// //
173 function locase1251 (ch
: AnsiChar): AnsiChar; inline;
177 if (ch
>= 'A') and (ch
<= 'Z') then Inc(ch
, 32);
181 if (ch
>= #192) and (ch
<= #223) then
188 #168, #170, #175: Inc(ch
, 16);
197 function strEquCI (const s0
, s1
: AnsiString): Boolean;
202 result
:= (Length(s0
) = Length(s1
));
205 for f
:= 1 to Length(s0
) do
208 if (c0
>= 'a') and (c0
<= 'z') then Dec(c0
, 32); // poor man's `toupper()`
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;
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;
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;
229 // ////////////////////////////////////////////////////////////////////////// //
230 constructor TFUIEvent
.Create (atype
: TType
; akind
: TKind
);
232 FillChar(self
, sizeof(self
), 0);
235 mState
:= TState
.None
;
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;
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;
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;
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;
263 function TFUIEvent
.isHot (c
: AnsiChar): Boolean;
266 if (c
= #0) then exit
;
267 if (not alive
) or (not key
) then exit
;
271 if (ch
= #0) then exit
;
272 result
:= (locase1251(ch
) = c
);
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
= 'ÿ');
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
= ')');
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
= ' ');
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!
337 // ////////////////////////////////////////////////////////////////////////// //
338 // any mods = 255: nothing was defined
339 function parseModKeys (const s
: AnsiString; out kmods
: Byte; out mbuts
: Byte): AnsiString;
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
350 if (Length(s
)-pos
>= 1) and (s
[pos
+1] = '-') then
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;
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
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;
371 while (epos
> pos
) and (s
[epos
-1] <= ' ') do Dec(epos
);
372 if (epos
> pos
) then result
:= Copy(s
, pos
, epos
-pos
) else result
:= '';
376 operator
= (const s
: AnsiString; constref ev
: TFUIEvent
): Boolean;
382 operator
= (constref ev
: TFUIEvent
; const s
: AnsiString): Boolean;
388 modch
: AnsiChar = ' ';
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
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
;
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';
409 if (mbuts
= 255) then mbuts
:= 0;
410 if (kmods
= 255) then kmods
:= 0;
411 if (ev
.kstate
<> kmods
) then exit
;
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
422 if (not ev
.key
) then exit
;
423 if (strEquCI(kname
, 'Empty')) or (strEquCI(kname
, 'NoKey')) then
425 kfound
:= (ev
.scan
= 0);
430 for f
:= 1 to SDL_NUM_SCANCODES
-1 do
432 if (strEquCI(kname
, SDL_GetScancodeName(f
))) then begin kfound
:= (ev
.scan
= f
); break
; end;
435 if (not kfound
) then exit
;
437 //writeln(' scan=', ev.scan, '; found=', kfound);
439 if (but
<> -1) and (not ev
.mouse
) then exit
; // mouse kname, but not mouse event
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
);
449 result
:= (ev
.bstate
= mbuts
);
454 // ////////////////////////////////////////////////////////////////////////// //
455 procedure fuiResetKMState (sendEvents
: Boolean=true);
460 // generate mouse release events
461 if (curButState
<> 0) then
468 // checked each time, 'cause `evMouseCB` can be changed from the handler
469 if ((curButState
and mask
) <> 0) and (assigned(fuiEventCB
)) then
471 ev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Mouse
, TFUIEvent
.TKind
.Release
);
475 ev
.bstate
:= curButState
;
476 ev
.kstate
:= curModState
;
477 curButState
:= curButState
and (not mask
);
486 // generate modifier release events
487 if (curModState
<> 0) then
494 // checked each time, 'cause `evMouseCB` can be changed from the handler
495 if ((curModState
and mask
) <> 0) and (assigned(fuiEventCB
)) then
497 ev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Key
, TFUIEvent
.TKind
.Release
);
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;
507 //mev.bstate := 0{curMsButState}; // anyway
508 ev
.kstate
:= curModState
;
509 curModState
:= curModState
and (not mask
);