2009-01-09 00:50:56 -05:00
|
|
|
! Copyright (C) 2005, 2009 Slava Pestov.
|
2007-09-20 18:09:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2009-01-09 00:50:56 -05:00
|
|
|
USING: locals accessors kernel math namespaces sequences
|
|
|
|
math.vectors colors math.geometry.rect ui.commands ui.operations ui.gadgets
|
|
|
|
ui.gadgets.buttons ui.gadgets.worlds ui.gestures ui.gadgets.theme
|
|
|
|
ui.gadgets.packs ui.gadgets.glass ui.gadgets.borders ;
|
2007-09-20 18:09:08 -04:00
|
|
|
IN: ui.gadgets.menus
|
|
|
|
|
|
|
|
: menu-loc ( world menu -- loc )
|
2009-01-09 00:50:56 -05:00
|
|
|
[ dim>> ] [ pref-dim ] bi* [v-] hand-loc get-global vmin ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-11-30 16:03:05 -05:00
|
|
|
: show-menu ( owner menu -- )
|
2009-01-09 00:50:56 -05:00
|
|
|
[ find-world dup ] dip tuck menu-loc show-glass ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-11-30 16:03:05 -05:00
|
|
|
:: <menu-item> ( target hook command -- button )
|
|
|
|
command command-name [
|
|
|
|
hook call
|
|
|
|
target command command-button-quot call
|
|
|
|
hand-clicked get find-world hide-glass
|
|
|
|
] <roll-button> ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-06-18 23:30:54 -04:00
|
|
|
: menu-theme ( gadget -- gadget )
|
|
|
|
light-gray solid-interior
|
2007-09-20 18:09:08 -04:00
|
|
|
faint-boundary ;
|
|
|
|
|
2008-11-30 16:03:05 -05:00
|
|
|
: <commands-menu> ( target hook commands -- menu )
|
2008-11-26 00:04:34 -05:00
|
|
|
[ <filled-pile> ] 3dip
|
2008-11-30 16:03:05 -05:00
|
|
|
[ <menu-item> add-gadget ] with with each
|
2008-09-27 15:36:04 -04:00
|
|
|
5 <border> menu-theme ;
|
2008-11-30 16:03:05 -05:00
|
|
|
|
|
|
|
: show-commands-menu ( target commands -- )
|
|
|
|
[ dup [ ] ] dip <commands-menu> show-menu ;
|
2008-12-19 00:56:41 -05:00
|
|
|
|
|
|
|
: <operations-menu> ( target hook -- menu )
|
|
|
|
over object-operations <commands-menu> ;
|
|
|
|
|
|
|
|
: show-operations-menu ( gadget target -- )
|
|
|
|
[ ] <operations-menu> show-menu ;
|