From f75a52474b4505a031b091a40907ada4e76d2648 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 1 Dec 2008 13:15:47 -0600
Subject: [PATCH 1/4] flatland: minor changes

---
 extra/flatland/flatland.factor | 42 ++++++++++++++++++++++++++++++++++
 1 file changed, 42 insertions(+)

diff --git a/extra/flatland/flatland.factor b/extra/flatland/flatland.factor
index a33da32908..c98c5a6c57 100644
--- a/extra/flatland/flatland.factor
+++ b/extra/flatland/flatland.factor
@@ -176,3 +176,45 @@ METHOD: height ( <extent> -- height ) \\ top>>   bottom>> bi - ;
 ! METHOD: to-extent ( <rectangle> -- <extent> )
 !   { [ left>> ] [ right>> ] [ bottom>> ] [ top>> ] } cleave <extent> boa ;
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+METHOD: to-the-left-of?  ( sequence <rectangle> -- ? ) \\ x left  bi* < ;
+METHOD: to-the-right-of? ( sequence <rectangle> -- ? ) \\ x right bi* > ;
+
+METHOD: below? ( sequence <rectangle> -- ? ) \\ y bottom bi* < ;
+METHOD: above? ( sequence <rectangle> -- ? ) \\ y top    bi* > ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Some support for the' 'rect' class from math.geometry.rect'
+
+! METHOD: width  ( rect -- width  ) dim>> first  ;
+! METHOD: height ( rect -- height ) dim>> second ;
+
+! METHOD: left  ( rect -- left  ) loc>> x
+! METHOD: right ( rect -- right ) [ loc>> x ] [ width ] bi + ;
+
+! METHOD: to-the-left-of?  ( sequence rect -- ? ) [ x ] [ loc>> x ] bi* < ;
+! METHOD: to-the-right-of? ( sequence rect -- ? ) [ x ] [ loc>> x ] bi* > ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+USING: locals combinators ; 
+
+:: wrap ( POINT RECT -- POINT )
+    
+  {
+      { [ POINT RECT to-the-left-of?  ] [ RECT right ] }
+      { [ POINT RECT to-the-right-of? ] [ RECT left  ] }
+      { [ t                           ] [ POINT x    ] }
+  }
+  cond
+
+  {
+      { [ POINT RECT below? ] [ RECT top    ] }
+      { [ POINT RECT above? ] [ RECT bottom ] }
+      { [ t                 ] [ POINT y     ] }
+  }
+  cond
+
+  2array ;

From d9b4402ae212da65776d172d8990ce52fb7d003f Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 1 Dec 2008 13:16:30 -0600
Subject: [PATCH 2/4] boids.ui: removed

---
 extra/boids/ui/ui.factor | 176 ---------------------------------------
 1 file changed, 176 deletions(-)
 delete mode 100755 extra/boids/ui/ui.factor

diff --git a/extra/boids/ui/ui.factor b/extra/boids/ui/ui.factor
deleted file mode 100755
index ddb25ccd8d..0000000000
--- a/extra/boids/ui/ui.factor
+++ /dev/null
@@ -1,176 +0,0 @@
-
-USING: combinators.short-circuit kernel namespaces
-       math
-       math.trig
-       math.functions
-       math.vectors
-       math.parser
-       hashtables sequences threads
-       colors
-       opengl
-       opengl.gl
-       ui
-       ui.gadgets
-       ui.gadgets.handler
-       ui.gadgets.slate
-       ui.gadgets.theme
-       ui.gadgets.frames
-       ui.gadgets.labels
-       ui.gadgets.buttons
-       ui.gadgets.packs
-       ui.gadgets.grids
-       ui.gestures
-       assocs.lib vars rewrite-closures boids accessors
-       math.geometry.rect
-       newfx
-       processing.shapes ;
-
-IN: boids.ui
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! draw-boid
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: draw-boid ( boid -- )
-  glPushMatrix
-    dup pos>> gl-translate-2d
-        vel>> first2 rect> arg rad>deg 0 0 1 glRotated
-    { { 0 5 } { 0 -5 } { 20 0 } } triangle
-    fill-mode
-  glPopMatrix ;
-
-: draw-boids ( -- ) boids> [ draw-boid ] each ;
-
-: boid-color ( -- color ) T{ rgba f 1.0 0 0 0.3 } ;
-
-: display ( -- )
-  boid-color >fill-color
-  draw-boids ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: slate
-
-VAR: loop
-
-: run ( -- )
-  slate> rect-dim >world-size
-  iterate-boids
-  slate> relayout-1
-  yield
-  loop> [ run ] when ;
-
-: button* ( string quot -- button ) closed-quot <bevel-button> ;
-
-: toggle-loop ( -- ) loop> [ loop off ] [ loop on [ run ] in-thread ] if ;
-
-VARS: population-label cohesion-label alignment-label separation-label ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: update-population-label ( -- )
-  "Population: " boids> length number>string append
-  20 32 pad-right population-label> set-label-string ;
-
-: add-10-boids ( -- )
-  boids> 10 random-boids append >boids update-population-label ;
-
-: sub-10-boids ( -- )
-  boids> 10 tail >boids update-population-label ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: truncate-value ( n -- n ) 10 * round 10 / ;
-
-: update-cohesion-label ( -- )
-  "Cohesion: " cohesion-weight> truncate-value number>string append
-  20 32 pad-right cohesion-label> set-label-string ;
-
-: update-alignment-label ( -- )
-  "Alignment: " alignment-weight> truncate-value number>string append
-  20 32 pad-right alignment-label> set-label-string ;
-
-: update-separation-label ( -- )
-  "Separation: " separation-weight> truncate-value number>string append
-  20 32 pad-right separation-label> set-label-string ;
-
-: inc-cohesion-weight ( -- ) cohesion-weight inc* update-cohesion-label ;
-: dec-cohesion-weight ( -- ) cohesion-weight dec* update-cohesion-label ;
-
-: inc-alignment-weight ( -- ) alignment-weight inc* update-alignment-label ;
-: dec-alignment-weight ( -- ) alignment-weight dec* update-alignment-label ;
-
-: inc-separation-weight ( -- ) separation-weight inc* update-separation-label ;
-: dec-separation-weight ( -- ) separation-weight dec* update-separation-label ;
-
-: boids-window* ( -- )
-  init-variables init-world-size init-boids loop on
-
-  "" <label> reverse-video-theme >population-label update-population-label
-  "" <label> reverse-video-theme >cohesion-label   update-cohesion-label
-  "" <label> reverse-video-theme >alignment-label  update-alignment-label
-  "" <label> reverse-video-theme >separation-label update-separation-label
-
-  <frame>
-
-    <shelf>
-
-       1 >>fill
-
-      "ESC - Pause" [ drop toggle-loop ] button* add-gadget
-    
-      "1 - Randomize" [ drop randomize ] button* add-gadget
-    
-      <pile> 1 >>fill
-        population-label> add-gadget
-        "3 - Add 10" [ drop add-10-boids ] button* add-gadget
-        "2 - Sub 10" [ drop sub-10-boids ] button* add-gadget
-      add-gadget
-    
-      <pile> 1 >>fill
-        cohesion-label> add-gadget
-        "q - +0.1" [ drop inc-cohesion-weight ] button* add-gadget
-        "a - -0.1" [ drop dec-cohesion-weight ] button* add-gadget
-      add-gadget
-
-      <pile> 1 >>fill
-        alignment-label> add-gadget
-        "w - +0.1" [ drop inc-alignment-weight ] button* add-gadget
-        "s - -0.1" [ drop dec-alignment-weight ] button* add-gadget
-      add-gadget
-
-      <pile> 1 >>fill
-        separation-label> add-gadget
-        "e - +0.1" [ drop inc-separation-weight ] button* add-gadget
-        "d - -0.1" [ drop dec-separation-weight ] button* add-gadget
-      add-gadget
-
-    @top grid-add
-
-    C[ display ] <slate>
-      dup                    >slate
-      t                      >>clipped?
-      { 600 400 }            >>pdim
-      C[ [ run ] in-thread ] >>graft
-      C[ loop off ]          >>ungraft
-    @center grid-add
-
-  <handler> 
-    H{ } clone
-      T{ key-down f f "1"   } C[ drop randomize             ] is
-      T{ key-down f f "2"   } C[ drop sub-10-boids          ] is
-      T{ key-down f f "3"   } C[ drop add-10-boids          ] is
-      T{ key-down f f "q"   } C[ drop inc-cohesion-weight   ] is
-      T{ key-down f f "a"   } C[ drop dec-cohesion-weight   ] is
-      T{ key-down f f "w"   } C[ drop inc-alignment-weight  ] is
-      T{ key-down f f "s"   } C[ drop dec-alignment-weight  ] is
-      T{ key-down f f "e"   } C[ drop inc-separation-weight ] is
-      T{ key-down f f "d"   } C[ drop dec-separation-weight ] is
-      T{ key-down f f "ESC" } C[ drop toggle-loop           ] is
-    >>table
-
-  "Boids" open-window ;
-
-: boids-window ( -- ) [ [ boids-window* ] with-scope ] with-ui ;
-
-MAIN: boids-window

From c2d475b4b4a10e022fa3f39be3c8807c1bb550d7 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 1 Dec 2008 13:17:22 -0600
Subject: [PATCH 3/4] Remove various files under 'boids.ui'

---
 extra/boids/ui/authors.txt   |  1 -
 extra/boids/ui/deploy.factor | 15 ---------------
 extra/boids/ui/tags.txt      |  1 -
 3 files changed, 17 deletions(-)
 delete mode 100755 extra/boids/ui/authors.txt
 delete mode 100755 extra/boids/ui/deploy.factor
 delete mode 100644 extra/boids/ui/tags.txt

diff --git a/extra/boids/ui/authors.txt b/extra/boids/ui/authors.txt
deleted file mode 100755
index 6cfd5da273..0000000000
--- a/extra/boids/ui/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Eduardo Cavazos
diff --git a/extra/boids/ui/deploy.factor b/extra/boids/ui/deploy.factor
deleted file mode 100755
index 8b3c0baf76..0000000000
--- a/extra/boids/ui/deploy.factor
+++ /dev/null
@@ -1,15 +0,0 @@
-USING: tools.deploy.config ;
-H{
-    { deploy-math? t }
-    { deploy-word-props? f }
-    { deploy-c-types? f }
-    { deploy-ui? t }
-    { deploy-io 2 }
-    { deploy-threads? t }
-    { deploy-word-defs? f }
-    { deploy-compiler? t }
-    { deploy-unicode? f }
-    { deploy-name "Boids" }
-    { "stop-after-last-window?" t }
-    { deploy-reflection 1 }
-}
diff --git a/extra/boids/ui/tags.txt b/extra/boids/ui/tags.txt
deleted file mode 100644
index cb5fc203e1..0000000000
--- a/extra/boids/ui/tags.txt
+++ /dev/null
@@ -1 +0,0 @@
-demos

From 43889cb587e2746da80986f83da61a1bb975e294 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 1 Dec 2008 13:19:45 -0600
Subject: [PATCH 4/4] boids: Complete rewrite

---
 extra/boids/boids.factor | 490 ++++++++++++++++++++++++---------------
 1 file changed, 309 insertions(+), 181 deletions(-)

diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor
index 857abcf5d3..b0d5bda508 100644
--- a/extra/boids/boids.factor
+++ b/extra/boids/boids.factor
@@ -1,81 +1,44 @@
 
-USING: kernel namespaces
-       math
-       math.constants
-       math.functions
-       math.order
-       math.vectors
-       math.trig
-       math.ranges
-       combinators arrays sequences random vars
-       combinators.lib
-       combinators.short-circuit
+USING: kernel
+       namespaces
+       arrays
        accessors
+       strings
+       sequences
+       locals
+       threads
+       math
+       math.functions
+       math.trig
+       math.order
+       math.ranges
+       math.vectors
+       random
+       calendar
+       opengl.gl
+       opengl
+       ui
+       ui.gadgets
+       ui.gadgets.tracks
+       ui.gadgets.frames
+       ui.gadgets.grids
+       ui.render
+       multi-methods
+       multi-method-syntax
+       combinators.short-circuit.smart       
+       processing.shapes
        flatland ;
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 IN: boids
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-TUPLE: boid < <vel> ;
-
-C: <boid> boid
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: boids
-VAR: world-size
-VAR: time-slice
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: cohesion-weight
-VAR: alignment-weight
-VAR: separation-weight
-
-VAR: cohesion-view-angle
-VAR: alignment-view-angle
-VAR: separation-view-angle
-
-VAR: cohesion-radius
-VAR: alignment-radius
-VAR: separation-radius
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: init-variables ( -- )
-  1.0 >cohesion-weight
-  1.0 >alignment-weight
-  1.0 >separation-weight
-
-  75 >cohesion-radius
-  50 >alignment-radius
-  25 >separation-radius
-
-  180 >cohesion-view-angle
-  180 >alignment-view-angle
-  180 >separation-view-angle
-
-  10 >time-slice ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! random-boid and random-boids
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: random-pos ( -- pos ) world-size> [ random ] map ;
-
-: random-vel ( -- vel ) 2 [ drop -10 10 [a,b] random ] map ;
-
-: random-boid ( -- boid ) random-pos random-vel <boid> ;
-
-: random-boids ( n -- boids ) [ drop random-boid ] map ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : constrain ( n a b -- n ) rot min max ;
 
 : angle-between ( vec vec -- angle )
-  2dup v. -rot norm swap norm * / -1 1 constrain acos rad>deg ;
+  [ v. ] [ [ norm ] bi@ * ] 2bi / -1 1 constrain acos rad>deg ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -86,19 +49,47 @@ VAR: separation-radius
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+: in-radius? ( self other radius -- ? ) [ distance       ] dip     <= ;
+: in-view?   ( self other angle  -- ? ) [ relative-angle ] dip 2 / <= ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 : vsum ( vector-of-vectors -- vec ) { 0 0 } [ v+ ] reduce ;
 
 : vaverage ( seq-of-vectors -- seq ) [ vsum ] [ length ] bi v/n ;
 
 : average-position ( boids -- pos ) [ pos>> ] map vaverage ;
-
 : average-velocity ( boids -- vel ) [ vel>> ] map vaverage ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: in-range? ( self other radius -- ? ) >r distance r> <= ;
+TUPLE: <boid> < <vel> ;
 
-: in-view? ( self other angle -- ? ) >r relative-angle r> 2 / <= ;
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+TUPLE: <behaviour>
+  { weight     initial: 1.0 }
+  { view-angle initial: 180 }
+  { radius                  } ;
+
+TUPLE: <cohesion>   < <behaviour> { radius initial: 75 } ;
+TUPLE: <alignment>  < <behaviour> { radius initial: 50 } ;
+TUPLE: <separation> < <behaviour> { radius initial: 25 } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: within-neighborhood? ( SELF OTHER BEHAVIOUR -- ? )
+
+  SELF OTHER
+    {
+      [ BEHAVIOUR radius>>     in-radius? ]
+      [ BEHAVIOUR view-angle>> in-view?   ]
+      [ eq? not                           ]
+    }
+  && ;
+
+:: neighborhood ( SELF OTHERS BEHAVIOUR -- boids )
+  OTHERS [| OTHER | SELF OTHER BEHAVIOUR within-neighborhood? ] filter ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -106,127 +97,264 @@ VAR: separation-radius
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-! average_position(neighbors) - self_position
+GENERIC: force* ( sequence <boid> <behaviour> -- force )
 
-: within-cohesion-neighborhood? ( self other -- ? )
-  { [ cohesion-radius> in-range? ]
-    [ cohesion-view-angle> in-view? ]
-    [ eq? not ] }
-  2&& ;
+:: cohesion-force ( OTHERS SELF BEHAVIOUR -- force )
+  OTHERS average-position SELF pos>> v- normalize* BEHAVIOUR weight>> v*n ;
 
-: cohesion-neighborhood ( self -- boids )
-  boids> [ within-cohesion-neighborhood? ] with filter ;
+:: alignment-force ( OTHERS SELF BEHAVIOUR -- force )
+  OTHERS average-velocity normalize* BEHAVIOUR weight>> v*n ;
 
-: cohesion-force ( self -- force )
-  dup cohesion-neighborhood
-  dup empty?
-  [ 2drop { 0 0 } ]
-  [ average-position swap pos>> v- normalize* cohesion-weight> v*n ]
+:: separation-force ( OTHERS SELF BEHAVIOUR -- force )
+  SELF pos>> OTHERS average-position v- normalize* BEHAVIOUR weight>> v*n ;
+
+METHOD: force* ( sequence <boid> <cohesion>   -- force ) cohesion-force   ;
+METHOD: force* ( sequence <boid> <alignment>  -- force ) alignment-force  ;
+METHOD: force* ( sequence <boid> <separation> -- force ) separation-force ;
+
+:: force ( OTHERS SELF BEHAVIOUR -- force )
+  SELF OTHERS BEHAVIOUR neighborhood
+    [ { 0 0 } ]
+    [ SELF BEHAVIOUR force* ]
+  if-empty ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: random-boids ( count -- boids )
+  [
+    drop
+    <boid> new
+      2 [ drop         1000 random ] map >>pos
+      2 [ drop -10 10 [a,b] random ] map >>vel
+  ]
+  map ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: draw-boid ( boid -- )
+  glPushMatrix
+    dup pos>> gl-translate-2d
+        vel>> first2 rect> arg rad>deg 0 0 1 glRotated
+    { { 0 5 } { 0 -5 } { 20 0 } } triangle
+    fill-mode
+  glPopMatrix ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: gadget->sky ( gadget -- sky ) { 0 0 } swap dim>> <rectangle> boa ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+USE: syntax ! Switch back to non-multi-method 'TUPLE:' syntax
+
+TUPLE: <boids-gadget> < gadget paused boids behaviours time-slice ;
+
+M:  <boids-gadget> pref-dim*    ( <boids-gadget> -- dim ) drop { 600 400 } ;
+M:  <boids-gadget> ungraft*     ( <boids-gadget> --     ) t >>paused drop  ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+M:: <boids-gadget> draw-gadget* ( BOIDS-GADGET -- )
+
+  [let | SKY        [ BOIDS-GADGET gadget->sky   ]
+         BOIDS      [ BOIDS-GADGET boids>>       ]
+         TIME-SLICE [ BOIDS-GADGET time-slice>>  ]
+         BEHAVIOURS [ BOIDS-GADGET behaviours>>  ] |
+
+    BOIDS
+
+      [| SELF |
+
+        [wlet | force-due-to [| BEHAVIOUR | BOIDS SELF BEHAVIOUR force ] |
+
+          ! F = m a. M is 1. So F = a.
+            
+          [let | ACCEL [ BEHAVIOURS [ force-due-to ] map vsum ] |
+
+            [let | POS [ SELF pos>> SELF vel>> TIME-SLICE v*n v+ ]
+                   VEL [ SELF vel>> ACCEL      TIME-SLICE v*n v+ ] |
+
+              [let | POS [ POS SKY wrap   ]
+                     VEL [ VEL normalize* ] |
+                    
+                T{ <boid> f POS VEL } ] ] ] ]
+
+      ]
+      
+    map
+
+    BOIDS-GADGET (>>boids)
+
+    origin get
+      [ BOIDS-GADGET boids>> [ draw-boid ] each ]
+    with-translation ] ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: start-boids-thread ( GADGET -- )
+  GADGET f >>paused drop
+  [
+    [
+      GADGET paused>>
+        [ f ]
+        [ GADGET relayout-1 25 milliseconds sleep t ]
+      if
+    ]
+    loop
+  ]
+  in-thread ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: default-behaviours ( -- seq )
+  { <cohesion> <alignment> <separation> } [ new ] map ;
+
+: boids-gadget ( -- gadget )
+  <boids-gadget> new-gadget
+    100 random-boids   >>boids
+    default-behaviours >>behaviours
+    10                 >>time-slice
+    t                  >>clipped? ;
+
+: run-boids ( -- ) boids-gadget dup "Boids" open-window start-boids-thread ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+USING: math.parser
+       ui.gadgets.labels
+       ui.gadgets.buttons
+       ui.gadgets.packs ;
+
+: truncate-number ( n -- n ) 10 * round 10 / ;
+
+:: make-behaviour-control ( NAME BEHAVIOUR -- gadget )
+  [let | NAME-LABEL  [ NAME           <label> reverse-video-theme ]
+         VALUE-LABEL [ 20 32 <string> <label> reverse-video-theme ] |
+
+    [wlet | update-value-label [ ! ( -- )
+              BEHAVIOUR weight>> truncate-number number>string
+              VALUE-LABEL
+              set-label-string ] |
+
+      update-value-label
+      
+    <pile> 1 >>fill
+      { 1 0 } <track>
+        NAME-LABEL  0.5 track-add
+        VALUE-LABEL 0.5 track-add
+      add-gadget
+      
+      "+0.1"
+      [
+        drop
+        BEHAVIOUR [ 0.1 + ] change-weight drop
+        update-value-label
+      ]
+      <bevel-button> add-gadget
+      
+      "-0.1"
+      [
+        drop
+        BEHAVIOUR weight>> 0.1 >
+        [
+          BEHAVIOUR [ 0.1 - ] change-weight drop
+          update-value-label
+        ]
+        when
+      ]
+      <bevel-button> add-gadget ] ] ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: make-population-control ( BOIDS-GADGET -- gadget )
+  [let | VALUE-LABEL [ 20 32 <string> <label> reverse-video-theme ] |
+
+    [wlet | update-value-label [ ( -- )
+              BOIDS-GADGET boids>> length number>string
+              VALUE-LABEL
+              set-label-string ] |
+
+      update-value-label
+      
+      <pile> 1 >>fill
+    
+        { 1 0 } <track>
+          "Population: " <label> reverse-video-theme 0.5 track-add
+          VALUE-LABEL                                0.5 track-add
+        add-gadget
+
+        "Add 10"
+        [
+          drop
+          BOIDS-GADGET
+            BOIDS-GADGET boids>> 10 random-boids append
+          >>boids
+          drop
+          update-value-label
+        ]
+        <bevel-button>
+        add-gadget
+
+        "Sub 10"
+        [
+          drop
+          BOIDS-GADGET boids>> length 10 >
+          [
+            BOIDS-GADGET
+              BOIDS-GADGET boids>> 10 tail
+            >>boids
+            drop
+            update-value-label
+          ]
+          when
+        ]
+        <bevel-button>
+        add-gadget ] ] ( gadget -- gadget ) ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: pause-toggle ( BOIDS-GADGET -- )
+  BOIDS-GADGET paused>>
+    [ BOIDS-GADGET start-boids-thread ]
+    [ BOIDS-GADGET t >>paused drop    ]
   if ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+:: randomize-boids ( BOIDS-GADGET -- )
+  BOIDS-GADGET   BOIDS-GADGET boids>> length random-boids   >>boids drop ;
 
-! self_position - average_position(neighbors)
+: boids-app ( -- )
 
-: within-separation-neighborhood? ( self other -- ? )
-  { [ separation-radius> in-range? ]
-    [ separation-view-angle> in-view? ]
-    [ eq? not ] }
-  2&& ;
+  [let | BOIDS-GADGET [ boids-gadget ] |
 
-: separation-neighborhood ( self -- boids )
-  boids> [ within-separation-neighborhood? ] with filter ;
+    <frame>
 
-: separation-force ( self -- force )
-  dup separation-neighborhood
-  dup empty?
-  [ 2drop { 0 0 } ]
-  [ average-position swap pos>> swap v- normalize* separation-weight> v*n ]
-  if ;
+      <shelf>
+
+        1 >>fill
+
+        "Pause" [ drop BOIDS-GADGET pause-toggle ] <bevel-button> add-gadget
+
+        "Randomize"
+        [ drop BOIDS-GADGET randomize-boids ] <bevel-button> add-gadget
+
+        BOIDS-GADGET make-population-control add-gadget
+    
+        "Cohesion:   " BOIDS-GADGET behaviours>> first  make-behaviour-control 
+        "Alignment:  " BOIDS-GADGET behaviours>> second make-behaviour-control
+        "Separation: " BOIDS-GADGET behaviours>> third  make-behaviour-control
+
+        [ add-gadget ] tri@
+
+      @top grid-add
+
+      BOIDS-GADGET @center grid-add
+
+    "Boids" open-window
+
+    BOIDS-GADGET start-boids-thread ] ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-! average_velocity(neighbors)
-
-: within-alignment-neighborhood? ( self other -- ? )
-  { [ alignment-radius> in-range? ]
-    [ alignment-view-angle> in-view? ]
-    [ eq? not ] }
-  2&& ;
-
-: alignment-neighborhood ( self -- boids )
-  boids> [ within-alignment-neighborhood? ] with filter ;
-
-: alignment-force ( self -- force )
-  alignment-neighborhood
-  dup empty?
-  [ drop { 0 0 } ]
-  [ average-velocity normalize* alignment-weight> v*n ]
-  if ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! F = m a
-!
-! We let m be equal to 1 so then this is simply: F = a
-
-: acceleration ( boid -- acceleration )
-  { separation-force alignment-force cohesion-force } map-exec-with vsum ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! iterate-boid
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: world-width ( -- w ) world-size> first ;
-
-: world-height ( -- w ) world-size> second ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: below? ( n a b -- ? ) drop < ;
-
-: above? ( n a b -- ? ) nip > ;
-
-: wrap ( n a b -- n )
-  {
-    { [ 3dup below? ] [ 2nip     ] }
-    { [ 3dup above? ] [ drop nip ] }
-    { [ t           ] [ 2drop    ] }
-  }
-  cond ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: wrap-x ( x -- x ) 0 world-width 1- wrap ;
-
-: wrap-y ( y -- y ) 0 world-height 1- wrap ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: new-pos ( boid -- pos ) [ pos>> ] [ vel>> time-slice> v*n ] bi v+ ;
-
-: new-vel ( boid -- vel )
-  [ vel>> ] [ acceleration time-slice> v*n ] bi v+ normalize* ;
-
-: wrap-pos ( pos -- pos ) { [ wrap-x ] [ wrap-y ] } parallel-call ;
-
-: iterate-boid ( self -- self ) [ new-pos wrap-pos ] [ new-vel ] bi <boid> ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: iterate-boids ( -- ) boids> [ iterate-boid ] map >boids ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: init-boids ( -- ) 100 random-boids >boids ;
-
-: init-world-size ( -- ) { 100 100 } >world-size ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: randomize ( -- ) boids> length random-boids >boids ;
-
-: inc* ( variable -- ) dup  get 0.1 +  0 1 constrain  swap set ;
-
-: dec* ( variable -- ) dup  get 0.1 -  0 1 constrain  swap set ;
+: boids-main ( -- ) [ boids-app ] with-ui ;
 
+MAIN: boids-main
\ No newline at end of file