From: Slava Pestov Date: Wed, 3 Dec 2008 06:05:20 +0000 (-0600) Subject: Move a bunch of vocabularies to unmaintained, hopefully temporarily X-Git-Tag: 0.94~2296^2~6^2~6 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=e0af88bd974313735938870c3bdf1b61b2a262ec Move a bunch of vocabularies to unmaintained, hopefully temporarily --- diff --git a/extra/boids/authors.txt b/extra/boids/authors.txt deleted file mode 100644 index 6cfd5da273..0000000000 --- a/extra/boids/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor deleted file mode 100644 index 8319a2d8d9..0000000000 --- a/extra/boids/boids.factor +++ /dev/null @@ -1,363 +0,0 @@ - -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 - processing.shapes - flatland ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -IN: boids - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: constrain ( n a b -- n ) rot min max ; - -: angle-between ( vec vec -- angle ) - [ v. ] [ [ norm ] bi@ * ] 2bi / -1 1 constrain acos rad>deg ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: relative-position ( self other -- v ) swap [ pos>> ] bi@ v- ; - -: relative-angle ( self other -- angle ) - over vel>> -rot relative-position angle-between ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: 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 ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -TUPLE: < ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -TUPLE: - { weight initial: 1.0 } - { view-angle initial: 180 } - { radius } ; - -TUPLE: < { radius initial: 75 } ; -TUPLE: < { radius initial: 50 } ; -TUPLE: < { radius initial: 25 } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -:: within-neighborhood? ( SELF OTHER BEHAVIOUR -- ? ) - - SELF OTHER - { - [ BEHAVIOUR radius>> in-radius? ] - [ BEHAVIOUR view-angle>> in-view? ] - [ eq? not ] - } - 2&& ; - -:: neighborhood ( SELF OTHERS BEHAVIOUR -- boids ) - OTHERS [| OTHER | SELF OTHER BEHAVIOUR within-neighborhood? ] filter ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: normalize* ( u -- v ) { 0.001 0.001 } v+ normalize ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -GENERIC: force* ( sequence -- force ) - -:: cohesion-force ( OTHERS SELF BEHAVIOUR -- force ) - OTHERS average-position SELF pos>> v- normalize* BEHAVIOUR weight>> v*n ; - -:: alignment-force ( OTHERS SELF BEHAVIOUR -- force ) - OTHERS average-velocity normalize* BEHAVIOUR weight>> v*n ; - -:: separation-force ( OTHERS SELF BEHAVIOUR -- force ) - SELF pos>> OTHERS average-position v- normalize* BEHAVIOUR weight>> v*n ; - -METHOD: force* ( sequence -- force ) cohesion-force ; -METHOD: force* ( sequence -- force ) alignment-force ; -METHOD: force* ( sequence -- force ) separation-force ; - -:: force ( OTHERS SELF BEHAVIOUR -- force ) - SELF OTHERS BEHAVIOUR neighborhood - [ { 0 0 } ] - [ SELF BEHAVIOUR force* ] - if-empty ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: random-boids ( count -- boids ) - [ - drop - 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>> boa ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USE: syntax ! Switch back to non-multi-method 'TUPLE:' syntax - -TUPLE: < gadget paused boids behaviours time-slice ; - -M: pref-dim* ( -- dim ) drop { 600 400 } ; -M: ungraft* ( -- ) t >>paused drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -:: iterate-system ( 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{ f POS VEL } ] ] ] ] - - ] - - map - - BOIDS-GADGET (>>boids) ] ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -M:: draw-gadget* ( BOIDS-GADGET -- ) - origin get - [ BOIDS-GADGET boids>> [ draw-boid ] each ] - with-translation ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -:: start-boids-thread ( GADGET -- ) - GADGET f >>paused drop - [ - [ - GADGET paused>> - [ f ] - [ GADGET iterate-system GADGET relayout-1 1 milliseconds sleep t ] - if - ] - loop - ] - in-thread ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: default-behaviours ( -- seq ) - { } [ new ] map ; - -: boids-gadget ( -- 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