steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Update usages of old accessors from 'ui.gadgets.buttons'

db4
Eduardo Cavazos 2008-08-30 19:52:40 -05:00
parent 916d0b4271
commit 4bebffd170
2 changed files with 13 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/ui/gadgets/buttons/buttons-docs.factor
View File

@ -7,7 +7,7 @@ HELP: button
$nl $nl
"A button's appearance can vary depending on the state of the mouse button if the " { $snippet "interior" } " or " { $snippet "boundary" } " slots are set to instances of " { $link button-paint } "." "A button's appearance can vary depending on the state of the mouse button if the " { $snippet "interior" } " or " { $snippet "boundary" } " slots are set to instances of " { $link button-paint } "."
$nl $nl
"A button can be selected, which is distinct from being pressed. This state is held in the " { $link button-selected? } " slot, and is used by the " { $link <toggle-buttons> } " word to construct a row of buttons for choosing among several alternatives." } ; "A button can be selected, which is distinct from being pressed. This state is held in the " { $snippet "selected?" } " slot, and is used by the " { $link <toggle-buttons> } " word to construct a row of buttons for choosing among several alternatives." } ;
HELP: <button> HELP: <button>
{ $values { "label" gadget } { "quot" "a quotation with stack effect " { $snippet "( button -- )" } } { "button" "a new " { $link button } } } { $values { "label" gadget } { "quot" "a quotation with stack effect " { $snippet "( button -- )" } } { "button" "a new " { $link button } } }
@ -28,10 +28,10 @@ HELP: <repeat-button>
HELP: button-paint HELP: button-paint
{ $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " gneeric words by delegating to an object in one of four slots which depend on the state of the button being drawn:" { $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " gneeric words by delegating to an object in one of four slots which depend on the state of the button being drawn:"
{ $list { $list
{ { $link button-paint-plain } " - the button is inactive" } { { $snippet "plain" } " - the button is inactive" }
{ { $link button-paint-rollover } " - the button is under the mouse" } { { $snippet "rollover" } " - the button is under the mouse" }
{ { $link button-paint-pressed } " - the button is under the mouse and a mouse button is held down" } { { $snippet "pressed" } " - the button is under the mouse and a mouse button is held down" }
{ { $link button-paint-selected } " - the button is selected (see " { $link <toggle-buttons> } } { { $snippet "selected" } " - the button is selected (see " { $link <toggle-buttons> } }
} }
"The " { $link <roll-button> } " and " { $link <bevel-button> } " words create " { $link button } " instances with specific " { $link button-paint } "." } ; "The " { $link <roll-button> } " and " { $link <bevel-button> } " words create " { $link button } " instances with specific " { $link button-paint } "." } ;

17
basis/ui/gadgets/buttons/buttons.factor
View File

@ -25,14 +25,13 @@ TUPLE: button < border pressed? selected? quot ;
dup mouse-clicked? dup mouse-clicked?
over button-rollover? and over button-rollover? and
buttons-down? and buttons-down? and
over set-button-pressed? over (>>pressed?)
relayout-1 ; relayout-1 ;
: if-clicked ( button quot -- ) : if-clicked ( button quot -- )
>r dup button-update dup button-rollover? r> [ drop ] if ; >r dup button-update dup button-rollover? r> [ drop ] if ;
: button-clicked ( button -- ) : button-clicked ( button -- ) dup quot>> if-clicked ;
dup button-quot if-clicked ;
button H{ button H{
{ T{ button-up } [ button-clicked ] } { T{ button-up } [ button-clicked ] }
@ -106,7 +105,7 @@ TUPLE: checkmark-paint color ;
C: <checkmark-paint> checkmark-paint C: <checkmark-paint> checkmark-paint
M: checkmark-paint draw-interior M: checkmark-paint draw-interior
checkmark-paint-color set-color color>> set-color
origin get [ origin get [
rect-dim rect-dim
{ 0 0 } over gl-line { 0 0 } over gl-line
@ -145,18 +144,18 @@ TUPLE: checkbox < button ;
swap >>model ; swap >>model ;
M: checkbox model-changed M: checkbox model-changed
swap model-value over set-button-selected? relayout-1 ; swap model-value over (>>selected?) relayout-1 ;
TUPLE: radio-paint color ; TUPLE: radio-paint color ;
C: <radio-paint> radio-paint C: <radio-paint> radio-paint
M: radio-paint draw-interior M: radio-paint draw-interior
radio-paint-color set-color color>> set-color
origin get { 4 4 } v+ swap rect-dim { 8 8 } v- 12 gl-fill-circle ; origin get { 4 4 } v+ swap rect-dim { 8 8 } v- 12 gl-fill-circle ;
M: radio-paint draw-boundary M: radio-paint draw-boundary
radio-paint-color set-color color>> set-color
origin get { 1 1 } v+ swap rect-dim { 2 2 } v- 12 gl-circle ; origin get { 1 1 } v+ swap rect-dim { 2 2 } v- 12 gl-circle ;
: radio-knob-theme ( gadget -- ) : radio-knob-theme ( gadget -- )
@ -184,8 +183,8 @@ TUPLE: radio-control < button value ;
M: radio-control model-changed M: radio-control model-changed
swap model-value swap model-value
over radio-control-value = over value>> =
over set-button-selected? over (>>selected?)
relayout-1 ; relayout-1 ;
: <radio-controls> ( parent model assoc quot -- parent ) : <radio-controls> ( parent model assoc quot -- parent )