1 ! Copyright (C) 2005, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors kernel locals math.rectangles math.vectors
4 namespaces opengl sequences sorting ui.commands ui.gadgets
5 ui.gadgets.buttons ui.gadgets.glass ui.gadgets.packs
6 ui.gadgets.worlds ui.gestures ui.operations
7 ui.pens ui.pens.solid ui.theme ui.tools.common ;
10 : show-menu ( owner menu -- )
11 [ find-world ] dip hand-loc get-global { 0 0 } <rect> show-glass ;
13 GENERIC: <menu-item> ( target hook command -- button )
15 M:: object <menu-item> ( target hook command -- button )
16 command command-name [
18 target command command-button-quot call
24 TUPLE: separator-pen color ;
26 C: <separator-pen> separator-pen
28 M: separator-pen draw-interior
30 dim>> [ { 0 0.5 } v* ] [ { 1 0.5 } v* ] bi
31 [ v>integer ] bi@ gl-line ;
33 : <menu-items> ( items -- gadget )
34 [ <filled-pile> ] dip add-gadgets ;
44 menu-border-color <separator-pen> >>interior ;
46 : <menu> ( gadgets -- menu )
50 menu-border-color <solid> >>boundary
51 menu-background <solid> >>interior ;
53 : <commands-menu> ( target hook commands -- menu )
54 [ <menu-item> ] 2with map <menu> ;
56 : show-commands-menu ( target commands -- )
57 [ dup [ ] ] dip <commands-menu> show-menu ;
59 : <operations-menu> ( target hook -- menu )
60 over object-operations
61 [ primary-operation? ] partition
62 [ reverse ] [ [ command-name ] sort-with ] bi*
63 { ---- } glue <commands-menu> ;
65 : show-operations-menu ( gadget target hook -- )
66 <operations-menu> show-menu ;