(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