2005-02-01 20:14:03 -05:00
|
|
|
! Copyright (C) 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
IN: gadgets
|
|
|
|
USING: alien generic kernel lists math namespaces sdl sdl-event
|
|
|
|
sdl-video ;
|
|
|
|
|
2005-02-01 21:47:10 -05:00
|
|
|
SYMBOL: world
|
|
|
|
|
2005-02-01 20:14:03 -05:00
|
|
|
! The hand is a special gadget that holds mouse position and
|
|
|
|
! mouse button click state. The hand's parent is the world, but
|
|
|
|
! it is special in that the world does not list it as part of
|
|
|
|
! its contents.
|
|
|
|
TUPLE: hand click-pos clicked buttons delegate ;
|
|
|
|
|
2005-02-01 21:47:10 -05:00
|
|
|
C: hand ( world -- hand )
|
2005-02-02 22:00:46 -05:00
|
|
|
0 0 <point> <gadget> <box>
|
2005-02-01 21:47:10 -05:00
|
|
|
over set-hand-delegate
|
|
|
|
[ set-gadget-parent ] keep ;
|
2005-02-01 20:14:03 -05:00
|
|
|
|
2005-02-01 21:47:10 -05:00
|
|
|
: motion-gesture ( gesture hand -- )
|
|
|
|
#! Send the gesture to the gadget at the hand's position in
|
|
|
|
#! the world.
|
|
|
|
world get pick-up handle-gesture ;
|
2005-02-01 20:14:03 -05:00
|
|
|
|
2005-02-01 21:47:10 -05:00
|
|
|
: button-gesture ( gesture hand -- )
|
|
|
|
#! Send the gesture to the gadget at the hand's last click
|
|
|
|
#! position in the world. This is used to send a button up
|
|
|
|
#! to the gadget that was clicked, regardless of the mouse
|
|
|
|
#! position at the time of the button up.
|
|
|
|
hand-clicked handle-gesture ;
|
2005-02-01 20:14:03 -05:00
|
|
|
|
|
|
|
: button/ ( n hand -- )
|
|
|
|
[ hand-buttons unique ] keep set-hand-buttons ;
|
|
|
|
|
|
|
|
: button\ ( n hand -- )
|
|
|
|
[ hand-buttons remove ] keep set-hand-buttons ;
|