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}
26 // ////////////////////////////////////////////////////////////////////////// //
28 TFUIEvent
= packed record
39 // both for but and for bstate
49 TType
= (Key
, Mouse
, User
);
50 TKind
= (Release
, Press
, Motion
, SimpleChar
, Other
);
51 // SimpleChar: keyboard event with `ch`, but without `scan` (it is zero)
64 mType
: TType
; // event type: keyboard, mouse, etc...
65 mKind
: TKind
; // motion, press, release
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;
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);
80 but
: Word; // current pressed/released button, or 0 for motion
82 scan
: Word; // SDL_SCANCODE_XXX or 0 for character event
83 ch
: AnsiChar
; // converted to 1251; can be #0
89 // initial state is "None"
90 constructor Create (atype
: TType
; akind
: TKind
);
92 // event type checkers
93 function mouse (): Boolean; inline;
94 function key (): Boolean; inline;
95 function user (): Boolean; inline;
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;
103 function alive (): Boolean; inline; // not eaten and not cancelled
104 procedure eat (); inline;
105 procedure cancel (); inline;
107 procedure setSinking (); inline;
108 procedure setBubbling (); inline;
109 procedure setMine (); inline;
111 // compares `scan` with `c`
112 function isHot (c
: AnsiChar
): Boolean;
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
;
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
;
128 // ////////////////////////////////////////////////////////////////////////// //
129 // call this on window deactivation, for example
130 procedure fuiResetKMState (sendEvents
: Boolean=true);
133 // ////////////////////////////////////////////////////////////////////////// //
136 fuiEventCB
: procedure (var ev
: TFUIEvent
) = nil;
139 // ////////////////////////////////////////////////////////////////////////// //
140 function fuiMouseX (): Integer; inline;
141 function fuiMouseY (): Integer; inline;
142 function fuiButState (): Word; inline;
143 function fuiModState (): Word; inline;
145 procedure fuiSetMouseX (v
: Integer); inline;
146 procedure fuiSetMouseY (v
: Integer); inline;
147 procedure fuiSetButState (v
: Word); inline;
148 procedure fuiSetModState (v
: Word); inline;
151 // ////////////////////////////////////////////////////////////////////////// //
152 // any mods = 255: nothing was defined
153 function parseModKeys (const s
: AnsiString
; out kmods
: Byte; out mbuts
: Byte): AnsiString
;
155 operator
= (constref ev
: TFUIEvent
; const s
: AnsiString
): Boolean;
156 operator
= (const s
: AnsiString
; constref ev
: TFUIEvent
): Boolean;
162 curButState
: Word = 0;
163 curModState
: Word = 0;
168 // ////////////////////////////////////////////////////////////////////////// //
169 function locase1251 (ch
: AnsiChar
): AnsiChar
; inline;
173 if (ch
>= 'A') and (ch
<= 'Z') then Inc(ch
, 32);
177 if (ch
>= #192) and (ch
<= #223) then
184 #168, #170, #175: Inc(ch
, 16);
193 function strEquCI (const s0
, s1
: AnsiString
): Boolean;
198 result
:= (Length(s0
) = Length(s1
));
201 for f
:= 1 to Length(s0
) do
204 if (c0
>= 'a') and (c0
<= 'z') then Dec(c0
, 32); // poor man's `toupper()`
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;
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;
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;
225 // ////////////////////////////////////////////////////////////////////////// //
226 constructor TFUIEvent
.Create (atype
: TType
; akind
: TKind
);
228 FillChar(self
, sizeof(self
), 0);
231 mState
:= TState
.None
;
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;
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;
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;
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;
259 function TFUIEvent
.isHot (c
: AnsiChar
): Boolean;
262 if (c
= #0) then exit
;
263 if (not alive
) or (not key
) then exit
;
267 if (ch
= #0) then exit
;
268 result
:= (locase1251(ch
) = c
);
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
= 'ÿ');
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
= ')');
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
= ' ');
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!
333 // ////////////////////////////////////////////////////////////////////////// //
334 // any mods = 255: nothing was defined
335 function parseModKeys (const s
: AnsiString
; out kmods
: Byte; out mbuts
: Byte): AnsiString
;
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
346 if (Length(s
)-pos
>= 1) and (s
[pos
+1] = '-') then
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;
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
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;
367 while (epos
> pos
) and (s
[epos
-1] <= ' ') do Dec(epos
);
368 if (epos
> pos
) then result
:= Copy(s
, pos
, epos
-pos
) else result
:= '';
372 operator
= (const s
: AnsiString
; constref ev
: TFUIEvent
): Boolean;
378 operator
= (constref ev
: TFUIEvent
; const s
: AnsiString
): Boolean;
384 modch
: AnsiChar
= ' ';
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
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
;
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';
405 if (mbuts
= 255) then mbuts
:= 0;
406 if (kmods
= 255) then kmods
:= 0;
407 if (ev
.kstate
<> kmods
) then exit
;
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
418 if (not ev
.key
) then exit
;
419 if (strEquCI(kname
, 'Empty')) or (strEquCI(kname
, 'NoKey')) then
421 kfound
:= (ev
.scan
= 0);
426 for f
:= 1 to SDL_NUM_SCANCODES
-1 do
428 if (strEquCI(kname
, SDL_GetScancodeName(f
))) then begin kfound
:= (ev
.scan
= f
); break
; end;
431 if (not kfound
) then exit
;
433 //writeln(' scan=', ev.scan, '; found=', kfound);
435 if (but
<> -1) and (not ev
.mouse
) then exit
; // mouse kname, but not mouse event
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
);
445 result
:= (ev
.bstate
= mbuts
);
450 // ////////////////////////////////////////////////////////////////////////// //
451 procedure fuiResetKMState (sendEvents
: Boolean=true);
456 // generate mouse release events
457 if (curButState
<> 0) then
464 // checked each time, 'cause `evMouseCB` can be changed from the handler
465 if ((curButState
and mask
) <> 0) and (assigned(fuiEventCB
)) then
467 ev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Mouse
, TFUIEvent
.TKind
.Release
);
471 ev
.bstate
:= curButState
;
472 ev
.kstate
:= curModState
;
473 curButState
:= curButState
and (not mask
);
482 // generate modifier release events
483 if (curModState
<> 0) then
490 // checked each time, 'cause `evMouseCB` can be changed from the handler
491 if ((curModState
and mask
) <> 0) and (assigned(fuiEventCB
)) then
493 ev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Key
, TFUIEvent
.TKind
.Release
);
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;
503 //mev.bstate := 0{curMsButState}; // anyway
504 ev
.kstate
:= curModState
;
505 curModState
:= curModState
and (not mask
);