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
"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
"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>
{ $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
{ $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
{ { $link button-paint-plain } " - the button is inactive" }
{ { $link button-paint-rollover } " - the button is under the mouse" }
{ { $link button-paint-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 "plain" } " - the button is inactive" }
{ { $snippet "rollover" } " - the button is under the mouse" }
{ { $snippet "pressed" } " - the button is under the mouse and a mouse button is held down" }
{ { $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 } "." } ;

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

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