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

Fix circularity

db4
Slava Pestov 2008-11-20 23:54:27 -06:00
parent 5911ad913f
commit 9d68d5882a
2 changed files with 17 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2,10 +2,11 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel math models namespaces sequences USING: accessors arrays kernel math models namespaces sequences
strings quotations assocs combinators classes colors strings quotations assocs combinators classes colors
classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets classes.tuple locals alien.c-types fry opengl opengl.gl
ui.gadgets.borders ui.gadgets.labels ui.gadgets.theme math.vectors ui.commands ui.gadgets ui.gadgets.borders
ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.gadgets.labels ui.gadgets.theme ui.gadgets.tracks
ui.render math.geometry.rect locals alien.c-types ; ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.render
math.geometry.rect ;
IN: ui.gadgets.buttons IN: ui.gadgets.buttons
TUPLE: button < border pressed? selected? quot ; TUPLE: button < border pressed? selected? quot ;
@ -27,7 +28,7 @@ TUPLE: button < border pressed? selected? quot ;
relayout-1 ; relayout-1 ;
: if-clicked ( button quot -- ) : if-clicked ( button quot -- )
>r dup button-update dup button-rollover? r> [ drop ] if ; [ dup button-update dup button-rollover? ] dip [ drop ] if ;
: button-clicked ( button -- ) dup quot>> if-clicked ; : button-clicked ( button -- ) dup quot>> if-clicked ;
@ -219,9 +220,8 @@ M: radio-control model-changed
over value>> = >>selected? over value>> = >>selected?
relayout-1 ; relayout-1 ;
: <radio-controls> ( parent model assoc quot -- parent ) : <radio-controls> ( assoc model parent quot: ( value model label -- ) -- parent )
#! quot has stack effect ( value model label -- ) '[ _ swap _ call add-gadget ] assoc-each ; inline
swapd [ swapd call add-gadget ] 2curry assoc-each ; inline
: radio-button-theme ( gadget -- gadget ) : radio-button-theme ( gadget -- gadget )
{ 5 5 } >>gap { 5 5 } >>gap
@ -232,8 +232,7 @@ M: radio-control model-changed
: <radio-buttons> ( model assoc -- gadget ) : <radio-buttons> ( model assoc -- gadget )
<filled-pile> <filled-pile>
-rot spin [ <radio-button> ] <radio-controls>
[ <radio-button> ] <radio-controls>
{ 5 5 } >>gap ; { 5 5 } >>gap ;
: <toggle-button> ( value model label -- gadget ) : <toggle-button> ( value model label -- gadget )
@ -241,20 +240,19 @@ M: radio-control model-changed
: <toggle-buttons> ( model assoc -- gadget ) : <toggle-buttons> ( model assoc -- gadget )
<shelf> <shelf>
-rot spin [ <toggle-button> ] <radio-controls> ;
[ <toggle-button> ] <radio-controls> ;
: command-button-quot ( target command -- quot ) : command-button-quot ( target command -- quot )
[ invoke-command drop ] 2curry ; '[ _ _ invoke-command drop ] ;
: <command-button> ( target gesture command -- button ) : <command-button> ( target gesture command -- button )
[ command-string ] keep [ command-string swap ] keep command-button-quot <bevel-button> ;
swapd
command-button-quot
<bevel-button> ;
: <toolbar> ( target -- toolbar ) : <toolbar> ( target -- toolbar )
<shelf> <shelf>
swap swap
"toolbar" over class command-map commands>> swap "toolbar" over class command-map commands>> swap
[ -rot <command-button> add-gadget ] curry assoc-each ; '[ [ _ ] 2dip <command-button> add-gadget ] assoc-each ;
: add-toolbar ( track -- track )
dup <toolbar> f track-add ;

5
basis/ui/gadgets/tracks/tracks.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors io kernel namespaces fry USING: accessors io kernel namespaces fry
math math.vectors math.geometry.rect math.order math math.vectors math.geometry.rect math.order
sequences words ui.gadgets ui.gadgets.packs ui.gadgets.buttons ; sequences words ui.gadgets ui.gadgets.packs ;
IN: ui.gadgets.tracks IN: ui.gadgets.tracks
@ -57,9 +57,6 @@ M: track pref-dim* ( gadget -- dim )
: track-add ( track gadget constraint -- track ) : track-add ( track gadget constraint -- track )
pick sizes>> push add-gadget ; pick sizes>> push add-gadget ;
: add-toolbar ( track -- track )
dup <toolbar> f track-add ;
: track-remove ( track gadget -- track ) : track-remove ( track gadget -- track )
dupd dup [ dupd dup [
[ swap children>> index ] [ swap children>> index ]