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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Joe Groff 2008-07-13 20:19:56 -07:00
parent f80172e076 cd6a559258
commit cf12a4ec0b
5 changed files with 21 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
extra/boids/ui/ui.factor
View File

@ -114,6 +114,8 @@ VARS: population-label cohesion-label alignment-label separation-label ;
<frame> <frame>
<shelf>
{ {
[ "ESC - Pause" [ drop toggle-loop ] button* ] [ "ESC - Pause" [ drop toggle-loop ] button* ]
@ -139,7 +141,7 @@ VARS: population-label cohesion-label alignment-label separation-label ;
"e - +0.1" [ drop inc-separation-weight ] button* add-gadget "e - +0.1" [ drop inc-separation-weight ] button* add-gadget
"d - -0.1" [ drop dec-separation-weight ] button* add-gadget ] "d - -0.1" [ drop dec-separation-weight ] button* add-gadget ]
} [ call ] map [ [ gadget, ] each ] make-shelf } [ call ] map [ add-gadget ] each
1 over set-pack-fill 1 over set-pack-fill
over @top grid-add over @top grid-add

8
extra/color-picker/color-picker.factor
View File

@ -15,7 +15,8 @@ TUPLE: color-preview < gadget ;
: <color-preview> ( model -- gadget ) : <color-preview> ( model -- gadget )
color-preview new-gadget color-preview new-gadget
{ 100 100 } over set-rect-dim ; swap >>model
{ 100 100 } >>dim ;
M: color-preview model-changed M: color-preview model-changed
swap model-value over set-gadget-interior relayout-1 ; swap model-value over set-gadget-interior relayout-1 ;
@ -26,7 +27,10 @@ M: color-preview model-changed
: <color-sliders> ( -- model gadget ) : <color-sliders> ( -- model gadget )
3 [ 0 0 0 255 <range> ] replicate 3 [ 0 0 0 255 <range> ] replicate
dup [ range-model ] map <compose> dup [ range-model ] map <compose>
swap [ [ <color-slider> gadget, ] each ] make-filled-pile ; swap
<filled-pile>
swap
[ <color-slider> add-gadget ] each ;
: <color-picker> ( -- gadget ) : <color-picker> ( -- gadget )
[ [

4
extra/ui/gadgets/gadgets-docs.factor
View File

@ -180,10 +180,6 @@ HELP: focusable-child
{ $values { "gadget" gadget } { "child" gadget } } { $values { "gadget" gadget } { "child" gadget } }
{ $description "Outputs the child of the gadget which would prefer to receive keyboard focus." } ; { $description "Outputs the child of the gadget which would prefer to receive keyboard focus." } ;
HELP: gadget,
{ $values { "gadget" gadget } }
{ $description "Adds a new child to the gadget being constructed. This word can only be used from a quotation passed to " { $link make-gadget } "." } ;
HELP: make-gadget HELP: make-gadget
{ $values { "gadget" gadget } { "quot" quotation } } { $values { "gadget" gadget } { "quot" quotation } }
{ $description "Calls the quotation in a new scope with the gadget stored in the " { $link gadget } " variable." } ; { $description "Calls the quotation in a new scope with the gadget stored in the " { $link gadget } " variable." } ;

2
extra/ui/gadgets/gadgets.factor
View File

@ -357,8 +357,6 @@ M: f request-focus-on 2drop ;
: focus-path ( world -- seq ) : focus-path ( world -- seq )
[ focus>> ] follow ; [ focus>> ] follow ;
: gadget, ( gadget -- ) gadget get swap add-gadget drop ;
: g ( -- gadget ) gadget get ; : g ( -- gadget ) gadget get ;
: g-> ( x -- x x gadget ) dup g ; : g-> ( x -- x x gadget ) dup g ;

21
extra/ui/tools/search/search.factor
View File

@ -47,12 +47,12 @@ search-field H{
{ T{ key-down f f "RET" } [ find-search-list invoke-value-action ] } { T{ key-down f f "RET" } [ find-search-list invoke-value-action ] }
} set-gestures } set-gestures
: <search-model> ( producer -- model ) : <search-model> ( live-search producer -- live-search filter )
>r g live-search-field gadget-model >r dup field>> model>> ! live-search model :: producer
ui-running? [ 1/5 seconds <delay> ] when ui-running? [ 1/5 seconds <delay> ] when
[ "\n" join ] r> append <filter> ; [ "\n" join ] r> append <filter> ;
: <search-list> ( seq limited? presenter -- gadget ) : <search-list> ( live-search seq limited? presenter -- live-search list )
>r >r
[ limited-completions ] [ completions ] ? curry [ limited-completions ] [ completions ] ? curry
<search-model> <search-model>
@ -61,13 +61,14 @@ search-field H{
: <live-search> ( string seq limited? presenter -- gadget ) : <live-search> ( string seq limited? presenter -- gadget )
{ 0 1 } live-search new-track { 0 1 } live-search new-track
[ <search-field> >>field
<search-field> g-> set-live-search-field f track, dup field>> f track-add*
<search-list> g-> set-live-search-list -roll <search-list> >>list
<scroller> 1 track, dup list>> <scroller> 1 track-add*
] make-gadget
[ live-search-field set-editor-string ] keep swap
[ live-search-field end-of-document ] keep ; over field>> set-editor-string
dup field>> end-of-document ;
M: live-search focusable-child* live-search-field ; M: live-search focusable-child* live-search-field ;