2005-02-01 22:00:55 -05:00
|
|
|
! Copyright (C) 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
IN: gadgets
|
2005-09-11 20:46:55 -04:00
|
|
|
USING: arrays alien gadgets-layouts generic kernel lists math
|
2005-11-15 12:58:44 -05:00
|
|
|
namespaces sdl sequences strings freetype opengl ;
|
2005-02-01 22:00:55 -05:00
|
|
|
|
2005-12-17 00:12:32 -05:00
|
|
|
M: object handle-event ( event -- ) drop ;
|
|
|
|
|
|
|
|
: scroll-wheel? ( button -- ? ) { 4 5 } member? ;
|
2005-02-01 22:00:55 -05:00
|
|
|
|
|
|
|
M: button-down-event handle-event ( event -- )
|
2005-12-17 00:12:32 -05:00
|
|
|
update-clicked button-event-button dup scroll-wheel? [
|
|
|
|
dup 4 = [ wheel-up ] [ wheel-down ] ?
|
|
|
|
hand get hand-clicked handle-gesture drop
|
|
|
|
] [
|
|
|
|
dup hand get hand-buttons push
|
|
|
|
[ button-down ] button-gesture
|
|
|
|
] if ;
|
2005-02-01 22:00:55 -05:00
|
|
|
|
|
|
|
M: button-up-event handle-event ( event -- )
|
2005-12-17 00:12:32 -05:00
|
|
|
button-event-button dup scroll-wheel? [
|
|
|
|
dup hand get hand-buttons delete
|
|
|
|
dup [ button-up ] button-gesture
|
|
|
|
] unless drop ;
|
2005-02-05 11:52:24 -05:00
|
|
|
|
2005-07-12 20:30:05 -04:00
|
|
|
: motion-event-loc ( event -- loc )
|
2005-09-11 20:46:55 -04:00
|
|
|
dup motion-event-x swap motion-event-y 0 3array ;
|
2005-02-01 22:00:55 -05:00
|
|
|
|
2005-11-15 12:58:44 -05:00
|
|
|
M: motion-event handle-event ( event -- )
|
|
|
|
motion-event-loc move-hand ;
|
|
|
|
|
2005-02-07 10:24:03 -05:00
|
|
|
M: key-down-event handle-event ( event -- )
|
2005-02-12 21:15:30 -05:00
|
|
|
dup keyboard-event>binding
|
2005-10-07 20:26:21 -04:00
|
|
|
hand get hand-focus handle-gesture [
|
|
|
|
keyboard-event-unicode dup control? [
|
2005-02-12 21:15:30 -05:00
|
|
|
drop
|
|
|
|
] [
|
2005-10-07 20:26:21 -04:00
|
|
|
hand get hand-focus user-input drop
|
2005-09-24 15:21:17 -04:00
|
|
|
] if
|
2005-02-12 21:15:30 -05:00
|
|
|
] [
|
|
|
|
drop
|
2005-09-24 15:21:17 -04:00
|
|
|
] if ;
|
2005-11-15 12:58:44 -05:00
|
|
|
|
|
|
|
M: quit-event handle-event ( event -- )
|
|
|
|
drop stop-world ;
|
|
|
|
|
|
|
|
M: resize-event handle-event ( event -- )
|
|
|
|
flush-fonts
|
|
|
|
gl-resize
|
|
|
|
width get height get 0 3array world get set-gadget-dim ;
|