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 // ////////////////////////////////////////////////////////////////////////// //
32 // both for but and for bstate
42 TKind
= (Release
, Press
, Motion
);
49 kind
: TKind
; // motion, press, release
50 x
, y
: Integer; // current mouse position
51 dx
, dy
: Integer; // for wheel this is wheel motion, otherwise this is relative mouse motion
52 but
: Word; // current pressed/released button, or 0 for motion
53 bstate
: Word; // button state BEFORE event (i.e. press/release modifications aren't done yet)
54 kstate
: Word; // keyboard state (see THKeyEvent);
57 procedure intrInit (); inline; // init hidden fields
59 function press (): Boolean; inline;
60 function release (): Boolean; inline;
61 function motion (): Boolean; inline;
62 procedure eat (); inline;
63 procedure cancel (); inline;
66 property eaten
: Boolean read mEaten
;
67 property cancelled
: Boolean read mCancelled
;
81 TKind
= (Release
, Press
);
89 scan
: Word; // SDL_SCANCODE_XXX or 0 for character event
90 //sym: LongWord; // SDLK_XXX
91 ch
: AnsiChar; // converted to 1251; can be #0
92 x
, y
: Integer; // current mouse position
93 bstate
: Word; // button state
94 kstate
: Word; // keyboard state BEFORE event (i.e. press/release modifications aren't done yet)
97 procedure intrInit (); inline; // init hidden fields
99 function press (): Boolean; inline;
100 function release (): Boolean; inline;
101 procedure eat (); inline;
102 procedure cancel (); inline;
104 function isHot (c
: AnsiChar): Boolean;
107 property eaten
: Boolean read mEaten
;
108 property cancelled
: Boolean read mCancelled
;
112 // ////////////////////////////////////////////////////////////////////////// //
113 // call this on window deactivation, for example
114 procedure fuiResetKMState (sendEvents
: Boolean=true);
117 // ////////////////////////////////////////////////////////////////////////// //
120 evMouseCB
: procedure (var ev
: THMouseEvent
) = nil;
121 evKeyCB
: procedure (var ev
: THKeyEvent
) = nil;
124 // ////////////////////////////////////////////////////////////////////////// //
125 function fuiMouseX (): Integer; inline;
126 function fuiMouseY (): Integer; inline;
127 function fuiButState (): Word; inline;
128 function fuiModState (): Word; inline;
130 procedure fuiSetMouseX (v
: Integer); inline;
131 procedure fuiSetMouseY (v
: Integer); inline;
132 procedure fuiSetButState (v
: Word); inline;
133 procedure fuiSetModState (v
: Word); inline;
136 // ////////////////////////////////////////////////////////////////////////// //
137 // any mods = 255: nothing was defined
138 function parseModKeys (const s
: AnsiString; out kmods
: Byte; out mbuts
: Byte): AnsiString;
140 operator
= (constref ev
: THKeyEvent
; const s
: AnsiString): Boolean;
141 operator
= (const s
: AnsiString; constref ev
: THKeyEvent
): Boolean;
143 operator
= (constref ev
: THMouseEvent
; const s
: AnsiString): Boolean;
144 operator
= (const s
: AnsiString; constref ev
: THMouseEvent
): Boolean;
150 curButState
: Word = 0;
151 curModState
: Word = 0;
156 // ////////////////////////////////////////////////////////////////////////// //
157 function strEquCI (const s0
, s1
: AnsiString): Boolean;
162 result
:= (Length(s0
) = Length(s1
));
165 for f
:= 1 to Length(s0
) do
168 if (c0
>= 'a') and (c0
<= 'z') then Dec(c0
, 32); // poor man's `toupper()`
170 if (c1
>= 'a') and (c1
<= 'z') then Dec(c1
, 32); // poor man's `toupper()`
171 if (c0
<> c1
) then begin result
:= false; exit
; end;
177 // ////////////////////////////////////////////////////////////////////////// //
178 function fuiMouseX (): Integer; inline; begin result
:= curMsX
; end;
179 function fuiMouseY (): Integer; inline; begin result
:= curMsY
; end;
180 function fuiButState (): Word; inline; begin result
:= curButState
; end;
181 function fuiModState (): Word; inline; begin result
:= curModState
; end;
183 procedure fuiSetMouseX (v
: Integer); inline; begin curMsX
:= v
; end;
184 procedure fuiSetMouseY (v
: Integer); inline; begin curMsY
:= v
; end;
185 procedure fuiSetButState (v
: Word); inline; begin curButState
:= v
; end;
186 procedure fuiSetModState (v
: Word); inline; begin curModState
:= v
; end;
189 // ////////////////////////////////////////////////////////////////////////// //
190 procedure THMouseEvent
.intrInit (); inline; begin mEaten
:= false; mCancelled
:= false; end;
191 function THMouseEvent
.press (): Boolean; inline; begin result
:= (kind
= TKind
.Press
); end;
192 function THMouseEvent
.release (): Boolean; inline; begin result
:= (kind
= TKind
.Release
); end;
193 function THMouseEvent
.motion (): Boolean; inline; begin result
:= (kind
= TKind
.Motion
); end;
194 procedure THMouseEvent
.eat (); inline; begin mEaten
:= true; end;
195 procedure THMouseEvent
.cancel (); inline; begin mCancelled
:= true; end;
197 procedure THKeyEvent
.intrInit (); inline; begin mEaten
:= false; mCancelled
:= false; ch
:= #0; scan
:= 0; end;
198 function THKeyEvent
.press (): Boolean; inline; begin result
:= (kind
= TKind
.Press
); end;
199 function THKeyEvent
.release (): Boolean; inline; begin result
:= (kind
= TKind
.Release
); end;
200 procedure THKeyEvent
.eat (); inline; begin mEaten
:= true; end;
201 procedure THKeyEvent
.cancel (); inline; begin mCancelled
:= true; end;
203 function THKeyEvent
.isHot (c
: AnsiChar): Boolean;
205 if (c
= #0) or (scan
= 0) or (scan
= $FFFF) then begin result
:= false; exit
; end;
207 SDL_SCANCODE_A
: result
:= (c
= 'A') or (c
= 'a') or (c
= 'Ô') or (c
= 'ô');
208 SDL_SCANCODE_B
: result
:= (c
= 'B') or (c
= 'b') or (c
= 'È') or (c
= 'è');
209 SDL_SCANCODE_C
: result
:= (c
= 'C') or (c
= 'c') or (c
= 'Ñ') or (c
= 'ñ');
210 SDL_SCANCODE_D
: result
:= (c
= 'D') or (c
= 'd') or (c
= 'Â') or (c
= 'â');
211 SDL_SCANCODE_E
: result
:= (c
= 'E') or (c
= 'e') or (c
= 'Ó') or (c
= 'ó');
212 SDL_SCANCODE_F
: result
:= (c
= 'F') or (c
= 'f') or (c
= 'À') or (c
= 'à');
213 SDL_SCANCODE_G
: result
:= (c
= 'G') or (c
= 'g') or (c
= 'Ï') or (c
= 'ï');
214 SDL_SCANCODE_H
: result
:= (c
= 'H') or (c
= 'h') or (c
= 'Ð') or (c
= 'ð');
215 SDL_SCANCODE_I
: result
:= (c
= 'I') or (c
= 'i') or (c
= 'Ø') or (c
= 'ø');
216 SDL_SCANCODE_J
: result
:= (c
= 'J') or (c
= 'j') or (c
= 'Î') or (c
= 'î');
217 SDL_SCANCODE_K
: result
:= (c
= 'K') or (c
= 'k') or (c
= 'Ë') or (c
= 'ë');
218 SDL_SCANCODE_L
: result
:= (c
= 'L') or (c
= 'l') or (c
= 'Ä') or (c
= 'ä');
219 SDL_SCANCODE_M
: result
:= (c
= 'M') or (c
= 'm') or (c
= 'Ü') or (c
= 'ü');
220 SDL_SCANCODE_N
: result
:= (c
= 'N') or (c
= 'n') or (c
= 'Ò') or (c
= 'ò');
221 SDL_SCANCODE_O
: result
:= (c
= 'O') or (c
= 'o') or (c
= 'Ù') or (c
= 'ù');
222 SDL_SCANCODE_P
: result
:= (c
= 'P') or (c
= 'p') or (c
= 'Ç') or (c
= 'ç');
223 SDL_SCANCODE_Q
: result
:= (c
= 'Q') or (c
= 'q') or (c
= 'É') or (c
= 'é');
224 SDL_SCANCODE_R
: result
:= (c
= 'R') or (c
= 'r') or (c
= 'Ê') or (c
= 'ê');
225 SDL_SCANCODE_S
: result
:= (c
= 'S') or (c
= 's') or (c
= 'Û') or (c
= 'û');
226 SDL_SCANCODE_T
: result
:= (c
= 'T') or (c
= 't') or (c
= 'Å') or (c
= 'å');
227 SDL_SCANCODE_U
: result
:= (c
= 'U') or (c
= 'u') or (c
= 'Ã') or (c
= 'ã');
228 SDL_SCANCODE_V
: result
:= (c
= 'V') or (c
= 'v') or (c
= 'Ì') or (c
= 'ì');
229 SDL_SCANCODE_W
: result
:= (c
= 'W') or (c
= 'w') or (c
= 'Ö') or (c
= 'ö');
230 SDL_SCANCODE_X
: result
:= (c
= 'X') or (c
= 'x') or (c
= '×') or (c
= '÷');
231 SDL_SCANCODE_Y
: result
:= (c
= 'Y') or (c
= 'y') or (c
= 'Í') or (c
= 'í');
232 SDL_SCANCODE_Z
: result
:= (c
= 'Z') or (c
= 'z') or (c
= 'ß') or (c
= 'ÿ');
234 SDL_SCANCODE_1
: result
:= (c
= '1') or (c
= '!');
235 SDL_SCANCODE_2
: result
:= (c
= '2') or (c
= '@');
236 SDL_SCANCODE_3
: result
:= (c
= '3') or (c
= '#');
237 SDL_SCANCODE_4
: result
:= (c
= '4') or (c
= '$');
238 SDL_SCANCODE_5
: result
:= (c
= '5') or (c
= '%');
239 SDL_SCANCODE_6
: result
:= (c
= '6') or (c
= '^');
240 SDL_SCANCODE_7
: result
:= (c
= '7') or (c
= '&');
241 SDL_SCANCODE_8
: result
:= (c
= '8') or (c
= '*');
242 SDL_SCANCODE_9
: result
:= (c
= '9') or (c
= '(');
243 SDL_SCANCODE_0
: result
:= (c
= '0') or (c
= ')');
245 SDL_SCANCODE_RETURN
: result
:= (c
= #13) or (c
= #10);
246 SDL_SCANCODE_ESCAPE
: result
:= (c
= #27);
247 SDL_SCANCODE_BACKSPACE
: result
:= (c
= #8);
248 SDL_SCANCODE_TAB
: result
:= (c
= #9);
249 SDL_SCANCODE_SPACE
: result
:= (c
= ' ');
251 SDL_SCANCODE_MINUS
: result
:= (c
= '-');
252 SDL_SCANCODE_EQUALS
: result
:= (c
= '=');
253 SDL_SCANCODE_LEFTBRACKET
: result
:= (c
= '[') or (c
= '{');
254 SDL_SCANCODE_RIGHTBRACKET
: result
:= (c
= ']') or (c
= '}');
255 SDL_SCANCODE_BACKSLASH
, SDL_SCANCODE_NONUSHASH
: result
:= (c
= '\') or (c
= '|');
256 SDL_SCANCODE_SEMICOLON
: result
:= (c
= ';') or (c
= ':');
257 SDL_SCANCODE_APOSTROPHE
: result
:= (c
= '''') or (c
= '"');
258 SDL_SCANCODE_GRAVE
: result
:= (c
= '`') or (c
= '~');
259 SDL_SCANCODE_COMMA
: result
:= (c
= ',') or (c
= '<');
260 SDL_SCANCODE_PERIOD
: result
:= (c
= '.') or (c
= '>');
261 SDL_SCANCODE_SLASH
: result
:= (c
= '/') or (c
= '?');
263 else result
:= false;
268 // ////////////////////////////////////////////////////////////////////////// //
269 // any mods = 255: nothing was defined
270 function parseModKeys (const s
: AnsiString; out kmods
: Byte; out mbuts
: Byte): AnsiString;
277 //while (pos <= Length(s)) and (s[pos] <= ' ') do Inc(pos);
278 if (pos
< Length(s
)) and ((s
[pos
] = '+') or (s
[pos
] = '-') or (s
[pos
] = '*')) then Inc(pos
);
279 while (pos
<= Length(s
)) do
281 if (Length(s
)-pos
>= 1) and (s
[pos
+1] = '-') then
284 'C', 'c': begin if (kmods
= 255) then kmods
:= 0; kmods
:= kmods
or THKeyEvent
.ModCtrl
; Inc(pos
, 2); continue
; end;
285 'M', 'm': begin if (kmods
= 255) then kmods
:= 0; kmods
:= kmods
or THKeyEvent
.ModAlt
; Inc(pos
, 2); continue
; end;
286 'S', 's': begin if (kmods
= 255) then kmods
:= 0; kmods
:= kmods
or THKeyEvent
.ModShift
; Inc(pos
, 2); continue
; end;
290 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
293 'L', 'l': begin if (mbuts
= 255) then mbuts
:= 0; mbuts
:= mbuts
or THMouseEvent
.Left
; Inc(pos
, 4); continue
; end;
294 'R', 'r': begin if (mbuts
= 255) then mbuts
:= 0; mbuts
:= mbuts
or THMouseEvent
.Right
; Inc(pos
, 4); continue
; end;
295 'M', 'm': begin if (mbuts
= 255) then mbuts
:= 0; mbuts
:= mbuts
or THMouseEvent
.Middle
; Inc(pos
, 4); continue
; end;
302 while (epos
> pos
) and (s
[epos
-1] <= ' ') do Dec(epos
);
303 if (epos
> pos
) then result
:= Copy(s
, pos
, epos
-pos
) else result
:= '';
307 operator
= (constref ev
: THKeyEvent
; const s
: AnsiString): Boolean;
315 if (Length(s
) > 0) then
317 if (s
[1] = '+') then begin if (not ev
.press
) then exit
; end
318 else if (s
[1] = '-') then begin if (not ev
.release
) then exit
; end
319 else if (s
[1] = '*') then begin end
320 else if (not ev
.press
) then exit
;
322 kname
:= parseModKeys(s
, kmods
, mbuts
);
323 if (kmods
= 255) then kmods
:= 0;
324 if (ev
.kstate
<> kmods
) then exit
;
325 if (mbuts
<> 255) and (ev
.bstate
<> mbuts
) then exit
;
327 if (strEquCI(kname
, 'Enter')) then kname
:= 'RETURN';
329 for f
:= 0 to SDL_NUM_SCANCODES
-1 do
331 if strEquCI(kname
, SDL_GetScancodeName(f
)) then
333 result
:= (ev
.scan
= f
);
340 operator
= (const s
: AnsiString; constref ev
: THKeyEvent
): Boolean;
346 operator
= (constref ev
: THMouseEvent
; const s
: AnsiString): Boolean;
352 modch
: AnsiChar = ' ';
356 if (Length(s
) > 0) then
358 if (s
[1] = '+') then begin if (not ev
.press
) then exit
; modch
:= '+'; end
359 else if (s
[1] = '-') then begin if (not ev
.release
) then exit
; modch
:= '-'; end
360 else if (s
[1] = '*') then begin if (not ev
.motion
) then exit
; end
361 else if (not ev
.press
) then exit
;
364 kname
:= parseModKeys(s
, kmods
, mbuts
);
365 if strEquCI(kname
, 'LMB') then but
:= THMouseEvent
.Left
366 else if strEquCI(kname
, 'RMB') then but
:= THMouseEvent
.Right
367 else if strEquCI(kname
, 'MMB') then but
:= THMouseEvent
.Middle
368 else if strEquCI(kname
, 'WheelUp') or strEquCI(kname
, 'WUP') then but
:= THMouseEvent
.WheelUp
369 else if strEquCI(kname
, 'WheelDown') or strEquCI(kname
, 'WDN') or strEquCI(kname
, 'WDOWN') then but
:= THMouseEvent
.WheelDown
370 else if strEquCI(kname
, 'None') then but
:= 0
373 if (mbuts
= 255) then mbuts
:= 0;
374 if (kmods
= 255) then kmods
:= 0;
375 if (ev
.kstate
<> kmods
) then exit
;
376 if (modch
= '-') then mbuts
:= mbuts
or but
else if (modch
= '+') then mbuts
:= mbuts
and (not but
);
378 result
:= (ev
.bstate
= mbuts
) and (ev
.but
= but
);
382 operator
= (const s
: AnsiString; constref ev
: THMouseEvent
): Boolean;
388 // ////////////////////////////////////////////////////////////////////////// //
389 procedure fuiResetKMState (sendEvents
: Boolean=true);
395 // generate mouse release events
396 if (curButState
<> 0) then
403 // checked each time, 'cause `evMouseCB` can be changed from the handler
404 if ((curButState
and mask
) <> 0) and assigned(evMouseCB
) then
406 FillChar(mev
, sizeof(mev
), 0);
408 mev
.kind
:= mev
.TKind
.Release
;
414 mev
.bstate
:= curButState
;
415 mev
.kstate
:= curModState
;
416 curButState
:= curButState
and (not mask
);
425 // generate modifier release events
426 if (curModState
<> 0) then
433 // checked each time, 'cause `evMouseCB` can be changed from the handler
434 if ((curModState
and mask
) <> 0) and assigned(evKeyCB
) then
436 FillChar(kev
, sizeof(kev
), 0);
438 kev
.kind
:= kev
.TKind
.Release
;
440 THKeyEvent
.ModCtrl
: begin kev
.scan
:= SDL_SCANCODE_LCTRL
; {kev.sym := SDLK_LCTRL;}{arbitrary} end;
441 THKeyEvent
.ModAlt
: begin kev
.scan
:= SDL_SCANCODE_LALT
; {kev.sym := SDLK_LALT;}{arbitrary} end;
442 THKeyEvent
.ModShift
: begin kev
.scan
:= SDL_SCANCODE_LSHIFT
; {kev.sym := SDLK_LSHIFT;}{arbitrary} end;
443 THKeyEvent
.ModHyper
: begin kev
.scan
:= SDL_SCANCODE_LGUI
; {kev.sym := SDLK_LGUI;}{arbitrary} end;
448 mev
.bstate
:= 0{curMsButState}; // anyway
449 mev
.kstate
:= curModState
;
450 curModState
:= curModState
and (not mask
);