2005-01-31 22:32:06 -05:00
|
|
|
! Copyright (C) 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
IN: gadgets
|
2005-02-01 21:47:10 -05:00
|
|
|
USING: alien generic hashtables kernel lists sdl-event ;
|
|
|
|
|
|
|
|
: handle-gesture* ( gesture gadget -- ? )
|
|
|
|
tuck gadget-gestures hash* dup [
|
|
|
|
cdr call f
|
|
|
|
] [
|
|
|
|
2drop t
|
|
|
|
] ifte ;
|
2005-01-31 22:32:06 -05:00
|
|
|
|
|
|
|
: handle-gesture ( gesture gadget -- )
|
|
|
|
#! If a gadget's handle-gesture* generic returns t, the
|
|
|
|
#! event was not consumed and is passed on to the gadget's
|
|
|
|
#! parent.
|
2005-02-01 19:00:16 -05:00
|
|
|
dup [
|
|
|
|
2dup handle-gesture* [
|
|
|
|
gadget-parent handle-gesture
|
2005-01-31 22:32:06 -05:00
|
|
|
] [
|
|
|
|
2drop
|
|
|
|
] ifte
|
|
|
|
] [
|
|
|
|
2drop
|
|
|
|
] ifte ;
|
2005-02-01 20:14:03 -05:00
|
|
|
|
2005-02-01 21:47:10 -05:00
|
|
|
! Mouse gestures are lists where the first element is one of:
|
|
|
|
SYMBOL: motion
|
|
|
|
SYMBOL: button-up
|
|
|
|
SYMBOL: button-down
|