From ba6d70b7f728adbf2c55cc6cd9b3853ef45e1753 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 11 Jul 2008 19:28:48 -0500 Subject: [PATCH] springies: use math.physics --- extra/springies/springies.factor | 69 ++++++++++++++++++-------------- extra/springies/ui/ui.factor | 6 +-- 2 files changed, 42 insertions(+), 33 deletions(-) diff --git a/extra/springies/springies.factor b/extra/springies/springies.factor index 1856115863..2640423eb4 100755 --- a/extra/springies/springies.factor +++ b/extra/springies/springies.factor @@ -1,6 +1,6 @@ USING: kernel combinators sequences arrays math math.vectors - generalizations vars ; + generalizations vars accessors math.physics.vel ; IN: springies @@ -28,23 +28,27 @@ VAR: gravity ! node ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -TUPLE: node mass elas pos vel force ; +! TUPLE: node mass elas pos vel force ; + +TUPLE: node < vel mass elas force ; C: node -: >>pos ( node pos -- node ) over set-node-pos ; +! : >>pos ( node pos -- node ) over set-node-pos ; -: >>vel ( node vel -- node ) over set-node-vel ; +! : >>vel ( node vel -- node ) over set-node-vel ; -: pos-x ( node -- x ) node-pos first ; -: pos-y ( node -- y ) node-pos second ; -: vel-x ( node -- y ) node-vel first ; -: vel-y ( node -- y ) node-vel second ; +: set-node-vel ( vel node -- ) swap >>vel drop ; -: >>pos-x ( node x -- node ) over node-pos set-first ; -: >>pos-y ( node y -- node ) over node-pos set-second ; -: >>vel-x ( node x -- node ) over node-vel set-first ; -: >>vel-y ( node y -- node ) over node-vel set-second ; +: pos-x ( node -- x ) pos>> first ; +: pos-y ( node -- y ) pos>> second ; +: vel-x ( node -- y ) vel>> first ; +: vel-y ( node -- y ) vel>> second ; + +: >>pos-x ( node x -- node ) over pos>> set-first ; +: >>pos-y ( node y -- node ) over pos>> set-second ; +: >>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 ; @@ -61,7 +65,7 @@ TUPLE: spring rest-length k damp node-a node-b ; C: spring : end-points ( spring -- b-pos a-pos ) - [ spring-node-b node-pos ] [ spring-node-a node-pos ] bi ; + [ spring-node-b pos>> ] [ spring-node-a pos>> ] bi ; : spring-length ( spring -- length ) end-points v- norm ; @@ -112,10 +116,10 @@ C: spring ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : relative-velocity-a ( spring -- vel ) - [ spring-node-a node-vel ] [ spring-node-b node-vel ] bi v- ; + [ spring-node-a vel>> ] [ spring-node-b vel>> ] bi v- ; : unit-vec-b->a ( spring -- vec ) - [ spring-node-a node-pos ] [ spring-node-b node-pos ] bi v- ; + [ spring-node-a pos>> ] [ spring-node-b pos>> ] bi v- ; : relative-velocity-along-spring-a ( spring -- vel ) [ relative-velocity-a ] [ unit-vec-b->a ] bi vector-projection ; @@ -126,10 +130,10 @@ C: spring ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : relative-velocity-b ( spring -- vel ) - [ spring-node-b node-vel ] [ spring-node-a node-vel ] bi v- ; + [ spring-node-b vel>> ] [ spring-node-a vel>> ] bi v- ; : unit-vec-a->b ( spring -- vec ) - [ spring-node-b node-pos ] [ spring-node-a node-pos ] bi v- ; + [ spring-node-b pos>> ] [ spring-node-a pos>> ] bi v- ; : relative-velocity-along-spring-b ( spring -- vel ) [ relative-velocity-b ] [ unit-vec-a->b ] bi vector-projection ; @@ -210,9 +214,9 @@ C: spring : calc-acceleration ( node -- vec ) [ node-force ] [ node-mass ] bi v/n ; : new-vel ( node -- vel ) - [ node-vel ] [ calc-acceleration time-slice> v*n ] bi v+ ; + [ vel>> ] [ calc-acceleration time-slice> v*n ] bi v+ ; -: new-pos ( node -- pos ) [ node-pos ] [ node-vel time-slice> v*n ] bi v+ ; +: new-pos ( node -- pos ) [ pos>> ] [ vel>> time-slice> v*n ] bi v+ ; : iterate-node ( node -- ) dup new-pos >>pos @@ -231,16 +235,21 @@ C: spring ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : mass ( id x y x-vel y-vel mass elas -- ) - 7 nrot drop - 6 nrot 6 nrot 2array - 5 nrot 5 nrot 2array - 0 0 2array - nodes> swap suffix >nodes ; + node new + swap >>elas + swap >>mass + -rot 2array >>vel + -rot 2array >>pos + 0 0 2array >>force + nodes> swap suffix >nodes + drop ; : spng ( id id-a id-b k damp rest-length -- ) - 6 nrot drop - -rot - 5 nrot node-id - 5 nrot node-id - - springs> swap suffix >springs ; + spring new + swap >>rest-length + swap >>damp + swap >>k + swap node-id >>node-b + swap node-id >>node-a + springs> swap suffix >springs + drop ; \ No newline at end of file diff --git a/extra/springies/ui/ui.factor b/extra/springies/ui/ui.factor index 8aabe6b70b..365632e974 100644 --- a/extra/springies/ui/ui.factor +++ b/extra/springies/ui/ui.factor @@ -1,16 +1,16 @@ USING: kernel namespaces threads sequences math math.vectors opengl.gl opengl colors ui ui.gadgets ui.gadgets.slate - fry rewrite-closures vars springies ; + fry rewrite-closures vars springies accessors math.geometry.rect ; IN: springies.ui ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: draw-node ( node -- ) node-pos { -5 -5 } v+ dup { 10 10 } v+ gl-rect ; +: draw-node ( node -- ) pos>> { -5 -5 } v+ dup { 10 10 } v+ gl-rect ; : draw-spring ( spring -- ) - [ spring-node-a node-pos ] [ spring-node-b node-pos ] bi gl-line ; + [ spring-node-a pos>> ] [ spring-node-b pos>> ] bi gl-line ; : draw-nodes ( -- ) nodes> [ draw-node ] each ;