]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/boids/boids.factor
Harmonize spelling
[factor.git] / extra / boids / boids.factor
index d4314ade37ad5d0cf0b0ed22c9642be7e17fa847..7ca546fba50069332ff521b5c6bcccbaafd55579 100644 (file)
@@ -1,21 +1,24 @@
 ! 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 kernel
-literals locals math math.functions math.trig models opengl
-opengl.demo-support opengl.gl sequences threads ui 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.render ;
+
+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.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>
@@ -24,12 +27,12 @@ CONSTANT: initial-dt 5
 : <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 >>behaviours
         initial-dt >>dt ;
 
-M:  boids-gadget ungraft*
+M: boids-gadget ungraft*
     t >>paused drop ;
 
 : vec>deg ( vec -- deg )
@@ -53,7 +56,7 @@ M: boids-gadget draw-gadget* ( boids-gadget -- )
     boids>> draw-boids ;
 
 : iterate-system ( boids-gadget -- )
-    dup [ boids>> ] [ behaviours>> ] [ dt>> ] tri
+    dup [ boids>> ] [ behaviors>> ] [ dt>> ] tri
     simulate >>boids drop ;
 
 :: start-boids-thread ( gadget -- )
@@ -75,7 +78,7 @@ M: range-observer model-changed
     range-observer boa swap add-connection ;
 
 :: behavior-panel ( behavior -- gadget )
-    2 3 <frame> { 2 4 } >>gap { 0 0 } >>filled-cell
+    2 3 <frame> white-interior { 2 4 } >>gap { 0 0 } >>filled-cell
 
     "weight" <label> { 0 0 } grid-add
     behavior weight>> 100 * >fixnum 0 0 200 1 mr:<range>
@@ -92,7 +95,9 @@ M: range-observer model-changed
     dup [ deg>rad cos behavior angle-cos<< ] connect
     horizontal <slider> { 1 2 } grid-add
 
-    behavior class-of name>> <labeled-gadget> ;
+    { 5 5 } <border> white-interior
+
+    behavior class-of name>> COLOR: gray <framed-labeled-gadget> ;
 
 :: set-population ( n boids-gadget -- )
     boids-gadget [
@@ -101,17 +106,24 @@ M: range-observer model-changed
         [ neg random-boids append ] if
     ] change-boids drop ;
 
-: pause-toggle ( boids-gadget -- )
+<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 ;
 
-: randomize-boids ( boids-gadget -- )
-    [ length random-boids ] change-boids drop ;
+: com-randomize ( boids-gadget -- )
+    find-boids-gadget
+    [ length random-boids ] change-boids relayout-1 ;
 
 :: simulation-panel ( boids-gadget -- gadget )
-    <pile> { 2 2 } >>gap
+    <pile> white-interior
 
-    2 2 <frame> { 4 4 } >>gap { 0 0 } >>filled-cell
+    2 2 <frame> { 2 4 } >>gap { 0 0 } >>filled-cell
 
     "population" <label> { 0 0 } grid-add
     initial-population 0 0 200 10 mr:<range>
@@ -123,35 +135,40 @@ M: range-observer model-changed
     dup [ boids-gadget dt<< ] connect
     horizontal <slider> { 1 1 } grid-add
 
-    add-gadget
+    { 5 5 } <border> add-gadget
 
     <shelf> { 2 2 } >>gap
-    "pause" [ drop boids-gadget pause-toggle ]
+    "pause" [ drop boids-gadget com-pause ]
     <border-button> add-gadget
-    "randomize" [ drop boids-gadget randomize-boids ]
+    "randomize" [ drop boids-gadget com-randomize ]
     <border-button> add-gadget
 
-    add-gadget
+    { 5 5 } <border> add-gadget
+
+    "simulation" COLOR: gray <framed-labeled-gadget> ;
 
-    "simulation" <labeled-gadget> ;
+TUPLE: boids-frame < pack ;
 
-:: create-gadgets ( -- gadgets )
-    <shelf>
+:: <boids-frame> ( -- boids-frame )
+    boids-frame new horizontal >>orientation
     <boids-gadget> :> boids-gadget
     boids-gadget [ start-boids-thread ] keep
     add-gadget
 
-    <pile> { 2 2 } >>gap 1.0 >>fill
+    <pile> { 5 5 } >>gap 1.0 >>fill
 
     boids-gadget simulation-panel
     add-gadget
 
-    boids-gadget behaviours>>
+    boids-gadget behaviors>>
     [ behavior-panel add-gadget ] each
 
-    add-gadget
-    { 2 2 } <border> ;
+    { 5 5 } <border> add-gadget ;
+
+boids-frame "touchbar" f {
+    { f com-pause }
+    { f com-randomize }
+} define-command-map
 
 MAIN-WINDOW: boids { { title "Boids" } }
-    create-gadgets
-    >>gadgets ;
+    <boids-frame> >>gadgets ;