37 lines
1.2 KiB
Factor
37 lines
1.2 KiB
Factor
! Copyright (C) 2005, 2006 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
IN: gadgets-menus
|
|
USING: gadgets gadgets-borders gadgets-buttons gadgets-layouts
|
|
gadgets-labels gadgets-theme generic kernel lists math
|
|
namespaces sequences ;
|
|
|
|
: retarget-click ( gadget -- )
|
|
find-world dup hide-glass update-hand update-clicked ;
|
|
|
|
: menu-actions ( glass -- )
|
|
[ retarget-click ] [ button-down ] set-action ;
|
|
|
|
: menu-loc ( loc menu world -- loc )
|
|
[ rect-dim ] 2apply swap |v-| vmin ;
|
|
|
|
: show-menu ( loc menu gadget -- )
|
|
find-world 2dup show-glass
|
|
dup world-glass menu-actions
|
|
over >r menu-loc r> set-rect-loc ;
|
|
|
|
: show-hand-menu ( menu gadget -- )
|
|
hand-click-loc get-global -rot show-menu ;
|
|
|
|
: menu-item-quot ( quot -- quot )
|
|
[ keep find-world hide-glass ] curry ;
|
|
|
|
: menu-items ( assoc -- pile )
|
|
#! Given an association list mapping labels to quotations.
|
|
#! Prepend a call to hide-menu to each quotation.
|
|
[ first2 menu-item-quot >r <label> r> <roll-button> ] map
|
|
make-pile 1 over set-pack-fill ;
|
|
|
|
: <menu> ( assoc -- gadget )
|
|
#! Given an association list mapping labels to quotations.
|
|
menu-items <default-border> dup menu-theme ;
|