diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index 115854dcfd..5304565486 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -6,11 +6,16 @@ classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets ui.gadgets.borders ui.gadgets.labels ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.pens ui.pens.solid ui.pens.image ui.pens.tile math.rectangles locals fry -combinators.smart ; +combinators.smart call ; IN: ui.gadgets.buttons TUPLE: button < border pressed? selected? quot ; + + : button-update ( button -- ) dup [ mouse-clicked? ] [ button-rollover? ] bi and @@ -27,10 +34,10 @@ TUPLE: button < border pressed? selected? quot ; >>pressed? relayout-1 ; -: if-clicked ( button quot -- ) - [ dup button-update dup button-rollover? ] dip [ drop ] if ; - -: button-clicked ( button -- ) dup quot>> if-clicked ; +: button-clicked ( button -- ) + dup button-update + dup button-rollover? + [ dup quot>> call( button -- ) ] [ drop ] if ; button H{ { T{ button-up } [ button-clicked ] } @@ -51,9 +58,6 @@ pressed selected pressed-selected ; C: button-pen -: find-button ( gadget -- button ) - [ button? ] find-parent ; - : button-pen ( button pen -- button pen ) over find-button { { [ dup [ pressed?>> ] [ selected?>> ] bi and ] [ drop pressed-selected>> ] } @@ -79,23 +83,57 @@ M: button-pen pen-pref-dim } 2cleave ] [ vmax ] reduce-outputs ; +M: button-pen pen-background + button-pen pen-background ; + +M: button-pen pen-foreground + button-pen pen-foreground ; + +>align ; inline : roll-button-theme ( button -- button ) f COLOR: black dup f f >>boundary - f f COLOR: black f f >>interior + f f COLOR: dark-gray f f >>interior align-left ; inline +PRIVATE> + : ( label quot -- button )