basis/ui/gadgets/menus/menus.factor

   1 ! Copyright (C) 2005, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: colors.constants kernel locals math.rectangles
   4 namespaces sequences ui.commands ui.gadgets ui.gadgets.borders
   5 ui.gadgets.buttons ui.gadgets.glass ui.gadgets.packs
   6 ui.gadgets.worlds ui.gestures ui.operations ui.pens ui.pens.solid
   7 opengl math.vectors words accessors math math.order sorting ;
   8 IN: ui.gadgets.menus
   9
  10 : show-menu ( owner menu -- )
  11     [ find-world ] dip hand-loc get { 0 0 } <rect> show-glass ;
  12
  13 GENERIC: <menu-item> ( target hook command -- button )
  14
  15 M:: object <menu-item> ( target hook command -- button )
  16     command command-name [
  17         hook call
  18         target command command-button-quot call
  19         hide-glass
  20     ] <roll-button> ;
  21
  22 <PRIVATE
  23
  24 TUPLE: separator-pen color ;
  25
  26 C: <separator-pen> separator-pen
  27
  28 M: separator-pen draw-interior
  29     color>> gl-color
  30     dim>> [ { 0 0.5 } v* ] [ { 1 0.5 } v* ] bi
  31     [ [ >integer ] map ] bi@ gl-line ;
  32
  33 PRIVATE>
  34
  35 SINGLETON: ----
  36
  37 M: ---- <menu-item>
  38     3drop
  39     <gadget>
  40         { 0 5 } >>dim
  41         COLOR: black <separator-pen> >>interior ;
  42
  43 : menu-theme ( gadget -- gadget )
  44     COLOR: light-gray <solid> >>interior ;
  45
  46 : <commands-menu> ( target hook commands -- menu )
  47     [ <filled-pile> ] 3dip
  48     [ <menu-item> add-gadget ] with with each
  49     { 5 5 } <border> menu-theme ;
  50
  51 : show-commands-menu ( target commands -- )
  52     [ dup [ ] ] dip <commands-menu> show-menu ;
  53
  54 : <operations-menu> ( target hook -- menu )
  55     over object-operations
  56     [ primary-operation? ] partition
  57     [ reverse ] [ [ [ command-name ] compare ] sort ] bi*
  58     { ---- } glue <commands-menu> ;
  59
  60 : show-operations-menu ( gadget target hook -- )
  61     <operations-menu> show-menu ;