wisp
 
(Arne Babenhauserheide)
2014-06-08: merge

merge

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
@@ -208,6 +202,28 @@ format #t "Diffuse ~A\n" 0.1
 d20-diffuse world neighbors 0.1
 display : d20-as-text world
 newline
+format #t "Diffuse: ~A*(~A)\n" 100 0.1
+let loop : : steps 100
+    cond
+      : = 0 steps
+        . world
+      else
+        d20-diffuse world neighbors 0.1
+        loop : 1- steps
+display : d20-as-text world
+newline
+let 
+  : number 20
+    val 1
+  format #t "disturb: ~A to ~A\n" number val
+  vector-set! world (1- number) val
+  display : d20-as-text world
+  newline
+format #t "Diffuse ~A\n" 0.1
+d20-diffuse world neighbors 0.1
+display : d20-as-text world
+newline
+
 format #t "Advect: ~A*(~A)\n" 1000 0.001
 let loop : : steps 1000
     cond