2005-02-03 22:21:51 -05:00
|
|
|
! Copyright (C) 2005 Slava Pestov.
|
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
|
IN: gadgets
|
|
|
|
|
USING: generic kernel lists math namespaces sdl ;
|
|
|
|
|
|
|
|
|
|
: button-pressed ( button -- )
|
|
|
|
|
dup f bevel-up? set-paint-property redraw ;
|
|
|
|
|
|
|
|
|
|
: button-released ( button -- )
|
|
|
|
|
dup t bevel-up? set-paint-property redraw ;
|
|
|
|
|
|
|
|
|
|
: <button> ( label quot -- button )
|
|
|
|
|
>r <label> bevel-border
|
|
|
|
|
dup [ dup button-released ] r> append
|
|
|
|
|
[ button-up 1 ] set-action
|
|
|
|
|
dup [ button-pressed ]
|
2005-02-05 11:52:24 -05:00
|
|
|
[ button-down 1 ] set-action
|
|
|
|
|
dup [ USE: prettyprint . "Mouse left" USE: stdio print ]
|
|
|
|
|
[ mouse-leave ] set-action
|
|
|
|
|
dup [ USE: prettyprint . "Mouse enter" USE: stdio print ]
|
|
|
|
|
[ mouse-enter ] set-action ;
|
