36 lines
958 B
Factor
36 lines
958 B
Factor
|
! Copyright (C) 2005, 2006 Slava Pestov.
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
IN: gadgets
|
||
|
|
USING: arrays errors freetype gadgets generic hashtables
|
||
|
|
kernel math models namespaces opengl sequences ;
|
||
|
|
|
||
|
|
: menu-loc ( world menu -- loc )
|
||
|
|
>r rect-dim r> pref-dim [v-] hand-loc get-global vmin ;
|
||
|
|
|
||
|
|
TUPLE: menu-glass ;
|
||
|
|
|
||
|
|
C: menu-glass ( menu world -- glass )
|
||
|
|
dup delegate>gadget
|
||
|
|
>r over menu-loc over set-rect-loc r>
|
||
|
|
[ add-gadget ] keep ;
|
||
|
|
|
||
|
|
M: menu-glass layout* gadget-child prefer ;
|
||
|
|
|
||
|
|
: hide-glass ( world -- )
|
||
|
|
dup world-glass [ unparent ] when*
|
||
|
|
f swap set-world-glass ;
|
||
|
|
|
||
|
|
: show-glass ( gadget world -- )
|
||
|
|
over hand-clicked set-global
|
||
|
|
[ hide-glass ] keep
|
||
|
|
[ add-gadget ] 2keep
|
||
|
|
set-world-glass ;
|
||
|
|
|
||
|
|
: show-menu ( gadget owner -- )
|
||
|
|
find-world [ <menu-glass> ] keep show-glass ;
|
||
|
|
|
||
|
|
\ menu-glass H{
|
||
|
|
{ T{ button-down } [ find-world [ hide-glass ] when* ] }
|
||
|
|
{ T{ drag } [ update-clicked drop ] }
|
||
|
|
} set-gestures
|