wisp
 
(Arne Babenhauserheide)
2014-06-08: switch diffusion to triangle leapflrog.

switch diffusion to triangle leapflrog.

diff --git a/examples/d20world.w b/examples/d20world.w
--- a/examples/d20world.w
+++ b/examples/d20world.w
@@ -142,31 +142,25 @@ define : d20-cursor-up-text world-vector
            format #t "[~AA" : 1- : length lines
 
 define : d20-diffuse world neighbors D
-         . "Diffuse the values on the d20 using the diffusion constant D. Step 1: Simply iterative."
-         let loop : : neighbors-to-diffuse : iota : vector-length neighbors
-             cond 
-               : null? neighbors-to-diffuse
-                 . world
-               else
-                 let : : edges-to-diffuse-targets : vector-ref neighbors (car neighbors-to-diffuse)
-                         let*
-                           : edges-to-diffuse : append (list (car neighbors-to-diffuse)) : vector->list edges-to-diffuse-targets
-                             idx0 : list-ref edges-to-diffuse 0
-                             idx1 : list-ref edges-to-diffuse 1
-                             idx2 : list-ref edges-to-diffuse 2
-                             idx3 : list-ref edges-to-diffuse 3
-                             val0 : vector-ref world idx0
-                             val1 : vector-ref world idx1
-                             val2 : vector-ref world idx2
-                             val3 : vector-ref world idx3
-                             diff0 : * (/ D 3) : - val1 val0
-                             diff1 : * (/ D 3) : - val2 val0
-                             diff2 : * (/ D 3) : - val3 val0
-                           vector-set! world idx0 : + val0 diff0 diff1 diff2
-                           vector-set! world idx1 : - val1 diff0
-                           vector-set! world idx2 : - val2 diff1
-                           vector-set! world idx3 : - val3 diff2
-                 loop : cdr neighbors-to-diffuse
+       . "Diffuse the values on the d20 using the diffusion constant D. Step 1: Simply iterative."
+       let leapfrog : : targets '(0 1 2)
+           if : null?  targets
+             . world
+             let loop : : neighbors-to-diffuse : iota : vector-length neighbors
+                cond 
+                  : null? neighbors-to-diffuse
+                    leapfrog : cdr targets
+                  else
+                      let*
+                          : originidx : car neighbors-to-diffuse ; index in world and in neighbors
+                            targetleap : car targets
+                            targetidx : vector-ref (vector-ref neighbors originidx) targetleap
+                            originval : vector-ref world originidx
+                            targetval : vector-ref world targetidx
+                            diff : * (/ D 3) : - targetval originval
+                          vector-set! world originidx : + originval diff
+                          vector-set! world targetidx : - targetval diff
+                      loop : cdr neighbors-to-diffuse
 
 
 define : d20-advect world advection-directions A