New look for buttons
parent
9ebc487f44
commit
dd3a21f4f0
|
@ -3,10 +3,10 @@
|
||||||
USING: accessors arrays kernel math models namespaces sequences
|
USING: accessors arrays kernel math models namespaces sequences
|
||||||
strings quotations assocs combinators classes colors colors.constants
|
strings quotations assocs combinators classes colors colors.constants
|
||||||
classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
|
classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
|
||||||
ui.gadgets.borders ui.gadgets.labels
|
ui.gadgets.borders ui.gadgets.labels ui.gadgets.tracks
|
||||||
ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
|
ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.pens ui.pens.solid
|
||||||
ui.pens ui.pens.solid ui.pens.image math.rectangles locals
|
ui.pens.image ui.pens.tile math.rectangles locals fry
|
||||||
fry combinators.smart ;
|
combinators.smart ;
|
||||||
IN: ui.gadgets.buttons
|
IN: ui.gadgets.buttons
|
||||||
|
|
||||||
TUPLE: button < border pressed? selected? quot ;
|
TUPLE: button < border pressed? selected? quot ;
|
||||||
|
@ -84,24 +84,24 @@ M: button-pen pen-pref-dim
|
||||||
|
|
||||||
: roll-button-theme ( button -- button )
|
: roll-button-theme ( button -- button )
|
||||||
f COLOR: black <solid> dup f f <button-pen> >>boundary
|
f COLOR: black <solid> dup f f <button-pen> >>boundary
|
||||||
f f pressed-gradient f f <button-pen> >>interior
|
f f COLOR: black <solid> f f <button-pen> >>interior
|
||||||
align-left ; inline
|
align-left ; inline
|
||||||
|
|
||||||
: <roll-button> ( label quot -- button )
|
: <roll-button> ( label quot -- button )
|
||||||
<button> roll-button-theme ;
|
<button> roll-button-theme ;
|
||||||
|
|
||||||
: <border-button-pen> ( -- paint )
|
: <border-button-pen> ( -- pen )
|
||||||
plain-gradient
|
"button" "button-clicked"
|
||||||
rollover-gradient
|
[
|
||||||
pressed-gradient
|
"-left" "-middle" "-right"
|
||||||
selected-gradient
|
[ append theme-image ] tri-curry@ tri <tile-pen> dup
|
||||||
selected-gradient
|
] bi@ dup <button-pen> ;
|
||||||
<button-pen> ;
|
|
||||||
|
|
||||||
: border-button-theme ( gadget -- gadget )
|
: border-button-theme ( gadget -- gadget )
|
||||||
|
horizontal >>orientation
|
||||||
<border-button-pen> >>interior
|
<border-button-pen> >>interior
|
||||||
{ 5 5 } >>size
|
dup dup interior>> pen-pref-dim >>min-dim
|
||||||
faint-boundary ; inline
|
{ 10 0 } >>size ; inline
|
||||||
|
|
||||||
: <border-button> ( label quot -- button )
|
: <border-button> ( label quot -- button )
|
||||||
<button> border-button-theme ;
|
<button> border-button-theme ;
|
||||||
|
@ -199,9 +199,10 @@ M: radio-control model-changed
|
||||||
: <toolbar> ( target -- toolbar )
|
: <toolbar> ( target -- toolbar )
|
||||||
<shelf>
|
<shelf>
|
||||||
1 >>fill
|
1 >>fill
|
||||||
|
{ 5 5 } >>gap
|
||||||
swap
|
swap
|
||||||
[ [ "toolbar" ] dip class command-map commands>> ] keep
|
[ [ "toolbar" ] dip class command-map commands>> ] keep
|
||||||
'[ [ _ ] 2dip <command-button> add-gadget ] assoc-each ;
|
'[ [ _ ] 2dip <command-button> add-gadget ] assoc-each ;
|
||||||
|
|
||||||
: add-toolbar ( track -- track )
|
: add-toolbar ( track -- track )
|
||||||
dup <toolbar> f track-add ;
|
dup <toolbar> { 3 3 } <border> align-left f track-add ;
|
||||||
|
|
Loading…
Reference in New Issue