(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