library/ui/gadgets/menus.factor

   1 ! Copyright (C) 2005, 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: gadgets
   4 USING: arrays errors freetype gadgets-frames generic hashtables
   5 kernel math models namespaces opengl sequences ;
   6
   7 : menu-loc ( world menu -- loc )
   8     >r rect-dim r> pref-dim [v-] hand-loc get-global vmin ;
   9
  10 TUPLE: menu-glass ;
  11
  12 C: menu-glass ( menu world -- glass )
  13     dup delegate>gadget
  14     >r over menu-loc over set-rect-loc r>
  15     [ add-gadget ] keep ;
  16
  17 M: menu-glass layout* gadget-child prefer ;
  18
  19 : retarget-drag ( gadget -- )
  20     hand-gadget get-global hand-clicked get-global eq? [
  21         drop
  22     ] [
  23         hand-loc get-global swap find-world move-hand
  24     ] if ;
  25
  26 : hide-menu ( -- )
  27     find-world hide-glass f menu-mode? set-global ;
  28
  29 \ menu-glass H{
  30     { T{ button-up } [ hide-menu ] }
  31     { T{ drag } [ retarget-drag ] }
  32 } set-gestures
  33
  34 : show-menu ( gadget owner -- )
  35     find-world [ <menu-glass> ] keep [ show-glass ] keep
  36     t menu-mode? set-global ;