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

boids: hang the touchbar stuff onto a boids-frame.

factor-shell
John Benediktsson 2018-01-19 09:19:04 -08:00
parent 001ea5f6b4
commit ac48f893f3
1 changed files with 15 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
extra/boids/boids.factor
View File

@ -105,11 +105,18 @@ M: range-observer model-changed
[ neg random-boids append ] if [ neg random-boids append ] if
] change-boids drop ; ] change-boids drop ;
<PRIVATE
: find-boids-gadget ( gadget -- boids-gadget )
dup boids-gadget? [ children>> [ boids-gadget? ] find nip ] unless ;
PRIVATE>
: com-pause ( boids-gadget -- ) : com-pause ( boids-gadget -- )
find-boids-gadget
dup paused>> not [ >>paused ] keep dup paused>> not [ >>paused ] keep
[ drop ] [ start-boids-thread ] if ; [ drop ] [ start-boids-thread ] if ;
: com-randomize ( boids-gadget -- ) : com-randomize ( boids-gadget -- )
find-boids-gadget
[ length random-boids ] change-boids relayout-1 ; [ length random-boids ] change-boids relayout-1 ;
:: simulation-panel ( boids-gadget -- gadget ) :: simulation-panel ( boids-gadget -- gadget )
@ -139,9 +146,13 @@ M: range-observer model-changed
"simulation" COLOR: gray <framed-labeled-gadget> ; "simulation" COLOR: gray <framed-labeled-gadget> ;
:: create-gadgets ( -- gadgets ) TUPLE: boids-frame < pack ;
:: <boids-frame> ( -- boids-frame )
boids-frame new horizontal >>orientation
<boids-gadget> :> boids-gadget <boids-gadget> :> boids-gadget
boids-gadget [ start-boids-thread ] keep boids-gadget [ start-boids-thread ] keep
add-gadget
<pile> { 5 5 } >>gap 1.0 >>fill <pile> { 5 5 } >>gap 1.0 >>fill
@ -151,14 +162,12 @@ M: range-observer model-changed
boids-gadget behaviours>> boids-gadget behaviours>>
[ behavior-panel add-gadget ] each [ behavior-panel add-gadget ] each
{ 5 5 } <border> 2array ; { 5 5 } <border> add-gadget ;
boids-gadget "touchbar" f { boids-frame "touchbar" f {
{ f com-pause } { f com-pause }
{ f com-randomize } { f com-randomize }
} define-command-map } define-command-map
MAIN-WINDOW: boids { { title "Boids" } } MAIN-WINDOW: boids { { title "Boids" } }
0 >>fill <boids-frame> >>gadgets ;
horizontal >>orientation
create-gadgets >>gadgets ;