1 ! Copyright (C) 2005, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: locals accessors arrays ui.commands ui.gadgets
4 ui.gadgets.buttons ui.gadgets.worlds ui.gestures generic
5 hashtables kernel math models namespaces opengl sequences
6 math.vectors ui.gadgets.theme ui.gadgets.packs
7 ui.gadgets.borders colors math.geometry.rect ;
10 : menu-loc ( world menu -- loc )
11 [ rect-dim ] [ pref-dim ] bi* [v-] hand-loc get-global vmin ;
13 TUPLE: menu-glass < gadget ;
15 : <menu-glass> ( world menu -- glass )
20 M: menu-glass layout* gadget-child prefer ;
22 : hide-glass ( world -- )
23 [ [ unparent ] when* f ] change-glass drop ;
25 : show-glass ( world gadget -- )
26 [ [ hide-glass ] [ hand-clicked set-global ] bi* ]
31 : show-menu ( owner menu -- )
32 [ find-world dup ] dip <menu-glass> show-glass ;
35 { T{ button-down } [ find-world [ hide-glass ] when* ] }
36 { T{ drag } [ update-clicked drop ] }
39 :: <menu-item> ( target hook command -- button )
40 command command-name [
42 target command command-button-quot call
43 hand-clicked get find-world hide-glass
46 : menu-theme ( gadget -- gadget )
47 light-gray solid-interior
50 : <commands-menu> ( target hook commands -- menu )
51 [ <filled-pile> ] 3dip
52 [ <menu-item> add-gadget ] with with each
53 5 <border> menu-theme ;
55 : show-commands-menu ( target commands -- )
56 [ dup [ ] ] dip <commands-menu> show-menu ;