springies: use math.physics

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> 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 ;
+: set-node-vel ( vel node -- ) swap >>vel drop ;
-: pos-y ( node -- y ) node-pos second ;
-: vel-x ( node -- y ) node-vel first ;
-: vel-y ( node -- y ) node-vel second ;
 
-: >>pos-x ( node x -- node ) over node-pos set-first ;
+: pos-x ( node -- x ) pos>> first ;
-: >>pos-y ( node y -- node ) over node-pos set-second ;
+: pos-y ( node -- y ) pos>> second ;
-: >>vel-x ( node x -- node ) over node-vel set-first ;
+: vel-x ( node -- y ) vel>> first ;
-: >>vel-y ( node y -- node ) over node-vel set-second ;
+: 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> 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> 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> 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> 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> spring
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : mass ( id x y x-vel y-vel mass elas -- )
-  7 nrot drop
+  node new
-  6 nrot 6 nrot 2array
+    swap >>elas
-  5 nrot 5 nrot 2array
+    swap >>mass
-  0 0 2array <node>
+    -rot 2array >>vel
-  nodes> swap suffix >nodes ;
+    -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
+   spring new
-  -rot
+     swap >>rest-length
-  5 nrot node-id
+     swap >>damp
-  5 nrot node-id
+     swap >>k
-  <spring>
+     swap node-id >>node-b
-  springs> swap suffix >springs ;
+     swap node-id >>node-a
+   springs> swap suffix >springs
+   drop ;

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 ;