Split off ui.gadgets.glass from ui.gadgets.menus

db4
Slava Pestov 2009-01-08 23:50:56 -06:00
parent f4418410e9
commit a1c3b9b26b
2 changed files with 33 additions and 31 deletions

View File

@ -0,0 +1,26 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel namespaces ui.gadgets ui.gadgets.worlds
ui.gestures ;
IN: ui.gadgets.glass
TUPLE: glass < gadget ;
: <glass> ( child loc -- glass )
>>loc glass new-gadget swap add-gadget ;
M: glass layout* gadget-child prefer ;
: hide-glass ( world -- )
[ [ unparent ] when* f ] change-glass drop ;
: show-glass ( world child loc -- )
<glass>
[ [ hide-glass ] [ hand-clicked set-global ] bi* ]
[ [ add-gadget ] [ >>glass ] bi drop ]
2bi ;
\ glass H{
{ T{ button-down } [ find-world [ hide-glass ] when* ] }
{ T{ drag } [ update-clicked drop ] }
} set-gestures

View File

@ -1,40 +1,16 @@
! Copyright (C) 2005, 2008 Slava Pestov. ! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: locals accessors arrays ui.commands ui.operations ui.gadgets USING: locals accessors kernel math namespaces sequences
ui.gadgets.buttons ui.gadgets.worlds ui.gestures generic math.vectors colors math.geometry.rect ui.commands ui.operations ui.gadgets
hashtables kernel math models namespaces opengl sequences ui.gadgets.buttons ui.gadgets.worlds ui.gestures ui.gadgets.theme
math.vectors ui.gadgets.theme ui.gadgets.packs ui.gadgets.packs ui.gadgets.glass ui.gadgets.borders ;
ui.gadgets.borders colors math.geometry.rect ;
IN: ui.gadgets.menus IN: ui.gadgets.menus
: menu-loc ( world menu -- loc ) : menu-loc ( world menu -- loc )
[ rect-dim ] [ pref-dim ] bi* [v-] hand-loc get-global vmin ; [ dim>> ] [ pref-dim ] bi* [v-] hand-loc get-global vmin ;
TUPLE: menu-glass < gadget ;
: <menu-glass> ( world menu -- glass )
tuck menu-loc >>loc
menu-glass new-gadget
swap add-gadget ;
M: menu-glass layout* gadget-child prefer ;
: hide-glass ( world -- )
[ [ unparent ] when* f ] change-glass drop ;
: show-glass ( world gadget -- )
[ [ hide-glass ] [ hand-clicked set-global ] bi* ]
[ add-gadget drop ]
[ >>glass drop ]
2tri ;
: show-menu ( owner menu -- ) : show-menu ( owner menu -- )
[ find-world dup ] dip <menu-glass> show-glass ; [ find-world dup ] dip tuck menu-loc show-glass ;
\ menu-glass H{
{ T{ button-down } [ find-world [ hide-glass ] when* ] }
{ T{ drag } [ update-clicked drop ] }
} set-gestures
:: <menu-item> ( target hook command -- button ) :: <menu-item> ( target hook command -- button )
command command-name [ command command-name [