New look for buttons

db4
Slava Pestov 2009-02-14 20:46:13 -06:00
parent 9ebc487f44
commit dd3a21f4f0
1 changed files with 16 additions and 15 deletions

View File

@ -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 ;