diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index c89241f603..71697ed8fe 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -3,8 +3,6 @@ - "ker" C+u: for a moment, full vocab list is shown - some module operations don't work on module-links - list operations: what if nothing is selected? -- menu should stay up if mouse button released - - list usability - popup: -- close button - popup: -- pin button diff --git a/library/ui/gadgets/menus.factor b/library/ui/gadgets/menus.factor index 20361c8f83..ef70287674 100644 --- a/library/ui/gadgets/menus.factor +++ b/library/ui/gadgets/menus.factor @@ -16,17 +16,20 @@ C: menu-glass ( menu world -- glass ) M: menu-glass layout* gadget-child prefer ; -: retarget-drag ( gadget -- ) - hand-gadget get-global hand-clicked get-global eq? [ - drop - ] [ - hand-loc get-global swap find-world move-hand - ] if ; +: hide-glass ( world -- ) + dup world-glass [ unparent ] when* + f swap set-world-glass ; -\ menu-glass H{ - { T{ button-up } [ find-world [ hide-glass ] when* ] } - { T{ drag } [ retarget-drag ] } -} set-gestures +: show-glass ( gadget world -- ) + over hand-clicked set-global + [ hide-glass ] keep + [ add-gadget ] 2keep + set-world-glass ; : show-menu ( gadget owner -- ) find-world [ ] keep show-glass ; + +\ menu-glass H{ + { T{ button-down } [ find-world [ hide-glass ] when* ] } + { T{ drag } [ update-clicked drop ] } +} set-gestures diff --git a/library/ui/gadgets/presentations.factor b/library/ui/gadgets/presentations.factor index db33b3ec5e..1643b075ac 100644 --- a/library/ui/gadgets/presentations.factor +++ b/library/ui/gadgets/presentations.factor @@ -40,19 +40,25 @@ C: presentation ( gadget object -- button ) swap [ invoke-primary ] over set-gadget-delegate ; -: ( target command -- button ) +: (command-button) ( target command -- label quot ) dup command-name -rot - [ invoke-command drop ] curry curry - ; + [ invoke-command drop ] curry curry ; + +: ( target command -- button ) + (command-button) ; : ( command -- command ) [ hand-clicked get find-world hide-glass ] swap modify-command ; +: ( target command -- button ) + (command-button) ; + : ( target commands -- gadget ) - [ ] map - [ ] map-with - make-pile 1 over set-pack-fill ; + [ ] map-with + make-pile 1 over set-pack-fill + + dup menu-theme ; : hooked-operations ( hook obj -- seq ) object-operations swap modify-commands ; diff --git a/library/ui/gadgets/theme.factor b/library/ui/gadgets/theme.factor index 2d01ed266f..d84c9ef07f 100644 --- a/library/ui/gadgets/theme.factor +++ b/library/ui/gadgets/theme.factor @@ -72,7 +72,7 @@ USING: arrays gadgets kernel sequences styles ; plain-gradient over set-gadget-interior faint-boundary ; : roll-button-theme ( button -- ) - f faint solid-black f + f solid-black solid-black f swap set-gadget-boundary ; : caret-theme ( caret -- ) @@ -106,3 +106,9 @@ USING: arrays gadgets kernel sequences styles ; : popup-theme ( gadget -- ) T{ solid f { 0.95 0.95 0.95 0.95 } } swap set-gadget-interior ; + +: menu-theme ( gadget -- ) + T{ solid f { 0.95 0.95 0.95 0.95 } } + over set-gadget-interior + T{ solid f { 0.7 0.7 0.7 1.0 } } + swap set-gadget-boundary ; diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor index c13e81c916..b2637f83a6 100644 --- a/library/ui/gestures.factor +++ b/library/ui/gestures.factor @@ -179,7 +179,6 @@ SYMBOL: double-click-timeout dup hand-world set-global under-hand >r over hand-loc set-global pick-up hand-gadget set-global - menu-mode? get-global [ update-clicked ] when under-hand r> hand-gestures ; : send-button-down ( gesture loc world -- ) diff --git a/library/ui/world.factor b/library/ui/world.factor index f65bce4503..94a170b93c 100644 --- a/library/ui/world.factor +++ b/library/ui/world.factor @@ -22,8 +22,6 @@ focus focused? fonts handle loc ; -SYMBOL: menu-mode? - : free-fonts ( world -- ) dup world-handle select-gl-context world-fonts hash-values [ second free-sprites ] each ; @@ -78,14 +76,3 @@ M: world layout* ] when* drop ; M: world children-on nip gadget-children ; - -: hide-glass ( world -- ) - f menu-mode? set-global - dup world-glass [ unparent ] when* - f swap set-world-glass ; - -: show-glass ( gadget world -- ) - [ hide-glass ] keep - [ add-gadget ] 2keep - set-world-glass - t menu-mode? set-global ;