diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor index cff33c9d19..ab624a606b 100644 --- a/extra/boids/boids.factor +++ b/extra/boids/boids.factor @@ -73,10 +73,6 @@ VAR: separation-radius ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: distance ( boid boid -- n ) [ pos>> ] [ pos>> ] bi* v- norm ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : constrain ( n a b -- n ) rot min max ; : angle-between ( vec vec -- angle ) diff --git a/extra/math/physics/pos/pos.factor b/extra/math/physics/pos/pos.factor index 1582c42108..69155686c8 100644 --- a/extra/math/physics/pos/pos.factor +++ b/extra/math/physics/pos/pos.factor @@ -1,5 +1,17 @@ +USING: kernel sequences multi-methods accessors math.vectors ; + IN: math.physics.pos TUPLE: pos pos ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +GENERIC: distance ( a b -- c ) + +METHOD: distance { sequence sequence } v- norm ; + +METHOD: distance { pos pos } [ pos>> ] bi@ distance ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + diff --git a/extra/springies/springies.factor b/extra/springies/springies.factor index fb69783975..818aa675e2 100755 --- a/extra/springies/springies.factor +++ b/extra/springies/springies.factor @@ -28,16 +28,10 @@ VAR: gravity ! node ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! TUPLE: node mass elas pos vel force ; - TUPLE: node < vel mass elas force ; C: node -! : >>pos ( node pos -- node ) over set-node-pos ; - -! : >>vel ( node vel -- node ) over set-node-vel ; - : node-vel ( node -- vel ) vel>> ; : set-node-vel ( vel node -- ) swap >>vel drop ; @@ -52,9 +46,9 @@ C: node : >>vel-x ( node x -- node ) over vel>> set-first ; : >>vel-y ( node y -- node ) over vel>> set-second ; -: apply-force ( node vec -- ) over node-force v+ swap set-node-force ; +: apply-force ( node vec -- ) over force>> v+ >>force drop ; -: reset-force ( node -- ) 0 0 2array swap set-node-force ; +: reset-force ( node -- node ) 0 0 2array >>force ; : node-id ( id -- node ) 1- nodes> nth ; @@ -67,12 +61,12 @@ TUPLE: spring rest-length k damp node-a node-b ; C: spring : end-points ( spring -- b-pos a-pos ) - [ spring-node-b pos>> ] [ spring-node-a pos>> ] bi ; + [ node-b>> pos>> ] [ node-a>> pos>> ] bi ; : spring-length ( spring -- length ) end-points v- norm ; : stretch-length ( spring -- length ) - [ spring-length ] [ spring-rest-length ] bi - ; + [ spring-length ] [ rest-length>> ] bi - ; : dir ( spring -- vec ) end-points v- normalize ; @@ -87,14 +81,14 @@ C: spring ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: hooke-force-mag ( spring -- mag ) [ spring-k ] [ stretch-length ] bi * ; +: hooke-force-mag ( spring -- mag ) [ k>> ] [ stretch-length ] bi * ; : hooke-force ( spring -- force ) [ dir ] [ hooke-force-mag ] bi v*n ; : hooke-forces ( spring -- a b ) hooke-force dup vneg ; : act-on-nodes-hooke ( spring -- ) - [ spring-node-a ] [ spring-node-b ] [ ] tri hooke-forces swapd + [ node-a>> ] [ node-b>> ] [ ] tri hooke-forces swapd apply-force apply-force ; @@ -118,37 +112,37 @@ C: spring ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : relative-velocity-a ( spring -- vel ) - [ spring-node-a vel>> ] [ spring-node-b vel>> ] bi v- ; + [ node-a>> vel>> ] [ node-b>> vel>> ] bi v- ; : unit-vec-b->a ( spring -- vec ) - [ spring-node-a pos>> ] [ spring-node-b pos>> ] bi v- ; + [ node-a>> pos>> ] [ node-b>> pos>> ] bi v- ; : relative-velocity-along-spring-a ( spring -- vel ) [ relative-velocity-a ] [ unit-vec-b->a ] bi vector-projection ; : damping-force-a ( spring -- vec ) - [ relative-velocity-along-spring-a ] [ spring-damp ] bi v*n vneg ; + [ relative-velocity-along-spring-a ] [ damp>> ] bi v*n vneg ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : relative-velocity-b ( spring -- vel ) - [ spring-node-b vel>> ] [ spring-node-a vel>> ] bi v- ; + [ node-b>> vel>> ] [ node-a>> vel>> ] bi v- ; : unit-vec-a->b ( spring -- vec ) - [ spring-node-b pos>> ] [ spring-node-a pos>> ] bi v- ; + [ node-b>> pos>> ] [ node-a>> pos>> ] bi v- ; : relative-velocity-along-spring-b ( spring -- vel ) [ relative-velocity-b ] [ unit-vec-a->b ] bi vector-projection ; : damping-force-b ( spring -- vec ) - [ relative-velocity-along-spring-b ] [ spring-damp ] bi v*n vneg ; + [ relative-velocity-along-spring-b ] [ damp>> ] bi v*n vneg ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : act-on-nodes-damping ( spring -- ) dup - [ spring-node-a ] [ damping-force-a ] bi apply-force - [ spring-node-b ] [ damping-force-b ] bi apply-force ; + [ node-a>> ] [ damping-force-a ] bi apply-force + [ node-b>> ] [ damping-force-b ] bi apply-force ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -164,22 +158,22 @@ C: spring : bounce-top ( node -- ) world-height 1- >>pos-y - dup [ vel-y ] [ node-elas ] bi * neg >>vel-y + dup [ vel-y ] [ elas>> ] bi * neg >>vel-y drop ; : bounce-bottom ( node -- ) 0 >>pos-y - dup [ vel-y ] [ node-elas ] bi * neg >>vel-y + dup [ vel-y ] [ elas>> ] bi * neg >>vel-y drop ; : bounce-left ( node -- ) 0 >>pos-x - dup [ vel-x ] [ node-elas ] bi * neg >>vel-x + dup [ vel-x ] [ elas>> ] bi * neg >>vel-x drop ; : bounce-right ( node -- ) world-width 1- >>pos-x - dup [ vel-x ] [ node-elas ] bi * neg >>vel-x + dup [ vel-x ] [ elas>> ] bi * neg >>vel-x drop ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -213,7 +207,7 @@ C: spring ! F = ma -: calc-acceleration ( node -- vec ) [ node-force ] [ node-mass ] bi v/n ; +: calc-acceleration ( node -- vec ) [ force>> ] [ mass>> ] bi v/n ; : new-vel ( node -- vel ) [ vel>> ] [ calc-acceleration time-slice> v*n ] bi v+ ; @@ -223,7 +217,7 @@ C: spring : iterate-node ( node -- ) dup new-pos >>pos dup new-vel >>vel - dup reset-force + reset-force handle-bounce ; : iterate-nodes ( -- ) nodes> [ iterate-node ] each ;