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, either version 3 of the License, or
7 * (at your option) any later version.
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.
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/>.
17 {$INCLUDE ../shared/a_modes.inc}
27 // ////////////////////////////////////////////////////////////////////////// //
29 TFUIEvent
= packed record
40 // both for but and for bstate
50 TType
= (Key
, Mouse
, User
);
51 TKind
= (Release
, Press
, Motion
, SimpleChar
, Other
);
52 // SimpleChar: keyboard event with `ch`, but without `scan` (it is zero)
65 mType
: TType
; // event type: keyboard, mouse, etc...
66 mKind
: TKind
; // motion, press, release
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;
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);
81 but
: Word; // current pressed/released button, or 0 for motion
83 scan
: Word; // SDL_SCANCODE_XXX or 0 for character event
84 ch
: AnsiChar; // converted to 1251; can be #0
90 // initial state is "None"
91 constructor Create (atype
: TType
; akind
: TKind
);
93 // event type checkers
94 function mouse (): Boolean; inline;
95 function key (): Boolean; inline;
96 function user (): Boolean; inline;
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;
104 function alive (): Boolean; inline; // not eaten and not cancelled
105 procedure eat (); inline;
106 procedure cancel (); inline;
108 procedure setSinking (); inline;
109 procedure setBubbling (); inline;
110 procedure setMine (); inline;
112 // compares `scan` with `c`
113 function isHot (c
: AnsiChar): Boolean;
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
;
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
;
129 // ////////////////////////////////////////////////////////////////////////// //
130 // call this on window deactivation, for example
131 procedure fuiResetKMState (sendEvents
: Boolean=true);
134 // ////////////////////////////////////////////////////////////////////////// //
137 fuiEventCB
: procedure (var ev
: TFUIEvent
) = nil;
140 // ////////////////////////////////////////////////////////////////////////// //
141 function fuiMouseX (): Integer; inline;
142 function fuiMouseY (): Integer; inline;
143 function fuiButState (): Word; inline;
144 function fuiModState (): Word; inline;
146 procedure fuiSetMouseX (v
: Integer); inline;
147 procedure fuiSetMouseY (v
: Integer); inline;
148 procedure fuiSetButState (v
: Word); inline;
149 procedure fuiSetModState (v
: Word); inline;
152 // ////////////////////////////////////////////////////////////////////////// //
153 // any mods = 255: nothing was defined
154 function parseModKeys (const s
: AnsiString; out kmods
: Byte; out mbuts
: Byte): AnsiString;
156 operator
= (constref ev
: TFUIEvent
; const s
: AnsiString): Boolean;
157 operator
= (const s
: AnsiString; constref ev
: TFUIEvent
): Boolean;
163 curButState
: Word = 0;
164 curModState
: Word = 0;
169 // ////////////////////////////////////////////////////////////////////////// //
170 function locase1251 (ch
: AnsiChar): AnsiChar; inline;
174 if (ch
>= 'A') and (ch
<= 'Z') then Inc(ch
, 32);
178 if (ch
>= #192) and (ch
<= #223) then
185 #168, #170, #175: Inc(ch
, 16);
194 function strEquCI (const s0
, s1
: AnsiString): Boolean;
199 result
:= (Length(s0
) = Length(s1
));
202 for f
:= 1 to Length(s0
) do
205 if (c0
>= 'a') and (c0
<= 'z') then Dec(c0
, 32); // poor man's `toupper()`
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;
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;
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;
226 // ////////////////////////////////////////////////////////////////////////// //
227 constructor TFUIEvent
.Create (atype
: TType
; akind
: TKind
);
229 FillChar(self
, sizeof(self
), 0);
232 mState
:= TState
.None
;
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;
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;
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;
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;
260 function TFUIEvent
.isHot (c
: AnsiChar): Boolean;
263 if (c
= #0) then exit
;
264 if (not alive
) or (not key
) then exit
;
268 if (ch
= #0) then exit
;
269 result
:= (locase1251(ch
) = c
);
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
= 'ÿ');
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
= ')');
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
= ' ');
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!
334 // ////////////////////////////////////////////////////////////////////////// //
335 // any mods = 255: nothing was defined
336 function parseModKeys (const s
: AnsiString; out kmods
: Byte; out mbuts
: Byte): AnsiString;
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
347 if (Length(s
)-pos
>= 1) and (s
[pos
+1] = '-') then
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;
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
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;
368 while (epos
> pos
) and (s
[epos
-1] <= ' ') do Dec(epos
);
369 if (epos
> pos
) then result
:= Copy(s
, pos
, epos
-pos
) else result
:= '';
373 operator
= (const s
: AnsiString; constref ev
: TFUIEvent
): Boolean;
379 operator
= (constref ev
: TFUIEvent
; const s
: AnsiString): Boolean;
385 modch
: AnsiChar = ' ';
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
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
;
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';
406 if (mbuts
= 255) then mbuts
:= 0;
407 if (kmods
= 255) then kmods
:= 0;
408 if (ev
.kstate
<> kmods
) then exit
;
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
419 if (not ev
.key
) then exit
;
420 if (strEquCI(kname
, 'Empty')) or (strEquCI(kname
, 'NoKey')) then
422 kfound
:= (ev
.scan
= 0);
427 for f
:= 1 to SDL_NUM_SCANCODES
-1 do
429 if (strEquCI(kname
, SDL_GetScancodeName(f
))) then begin kfound
:= (ev
.scan
= f
); break
; end;
432 if (not kfound
) then exit
;
434 //writeln(' scan=', ev.scan, '; found=', kfound);
436 if (but
<> -1) and (not ev
.mouse
) then exit
; // mouse kname, but not mouse event
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
);
446 result
:= (ev
.bstate
= mbuts
);
451 // ////////////////////////////////////////////////////////////////////////// //
452 procedure fuiResetKMState (sendEvents
: Boolean=true);
457 // generate mouse release events
458 if (curButState
<> 0) then
465 // checked each time, 'cause `evMouseCB` can be changed from the handler
466 if ((curButState
and mask
) <> 0) and (assigned(fuiEventCB
)) then
468 ev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Mouse
, TFUIEvent
.TKind
.Release
);
472 ev
.bstate
:= curButState
;
473 ev
.kstate
:= curModState
;
474 curButState
:= curButState
and (not mask
);
483 // generate modifier release events
484 if (curModState
<> 0) then
491 // checked each time, 'cause `evMouseCB` can be changed from the handler
492 if ((curModState
and mask
) <> 0) and (assigned(fuiEventCB
)) then
494 ev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Key
, TFUIEvent
.TKind
.Release
);
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;
504 //mev.bstate := 0{curMsButState}; // anyway
505 ev
.kstate
:= curModState
;
506 curModState
:= curModState
and (not mask
);