! Copyright (C) 2008 Eduardo Cavazos.
! Copyright (C) 2011 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays boids.simulation calendar classes
-colors.constants kernel literals locals math math.functions
-math.trig models namespaces opengl opengl.demo-support opengl.gl
-sequences threads ui ui.commands ui.gadgets ui.gadgets.borders
+
+USING: accessors arrays boids.simulation calendar classes colors
+kernel literals math math.functions math.trig models
+models.range opengl opengl.demo-support opengl.gl sequences
+threads ui ui.commands ui.gadgets ui.gadgets.borders
ui.gadgets.buttons ui.gadgets.frames ui.gadgets.grids
ui.gadgets.labeled ui.gadgets.labels ui.gadgets.packs
-ui.gadgets.sliders ui.gadgets.tracks ui.gadgets.worlds ui.render
-ui.tools.common ;
+ui.gadgets.sliders ui.render ui.tools.common ;
+
QUALIFIED-WITH: models.range mr
IN: boids
-TUPLE: boids-gadget < gadget paused boids behaviours dt ;
+TUPLE: boids-gadget < gadget paused boids behaviors dt ;
CONSTANT: initial-population 100
CONSTANT: initial-dt 5
-: initial-behaviours ( -- seq )
+: initial-behaviors ( -- seq )
1.0 75 -0.1 <cohesion>
1.0 40 -0.5 <alignment>
1.0 25 -1.0 <separation>
: <boids-gadget> ( -- gadget )
boids-gadget new
t >>clipped?
- ${ width height } >>pref-dim
+ ${ WIDTH HEIGHT } >>pref-dim
initial-population random-boids >>boids
- initial-behaviours >>behaviours
+ initial-behaviors >>behaviors
initial-dt >>dt ;
-M: boids-gadget ungraft*
+M: boids-gadget ungraft*
t >>paused drop ;
: vec>deg ( vec -- deg )
boids>> draw-boids ;
: iterate-system ( boids-gadget -- )
- dup [ boids>> ] [ behaviours>> ] [ dt>> ] tri
+ dup [ boids>> ] [ behaviors>> ] [ dt>> ] tri
simulate >>boids drop ;
:: start-boids-thread ( gadget -- )
[ neg random-boids append ] if
] change-boids drop ;
+<PRIVATE
+: find-boids-gadget ( gadget -- boids-gadget )
+ dup boids-gadget? [ children>> [ boids-gadget? ] find nip ] unless ;
+PRIVATE>
+
: com-pause ( boids-gadget -- )
+ find-boids-gadget
dup paused>> not [ >>paused ] keep
[ drop ] [ start-boids-thread ] if ;
: com-randomize ( boids-gadget -- )
+ find-boids-gadget
[ length random-boids ] change-boids relayout-1 ;
:: simulation-panel ( boids-gadget -- 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 [ start-boids-thread ] keep
+ add-gadget
<pile> { 5 5 } >>gap 1.0 >>fill
boids-gadget simulation-panel
add-gadget
- boids-gadget behaviours>>
+ boids-gadget behaviors>>
[ 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-randomize }
} define-command-map
MAIN-WINDOW: boids { { title "Boids" } }
- 0 >>fill
- horizontal >>orientation
- create-gadgets >>gadgets ;
+ <boids-frame> >>gadgets ;