eb24ec7b5d33 — Leonard Ritter 20 days ago
* more work on emulating recursion in tukan
* more work on blue noise technique
2 files changed, 208 insertions(+), 34 deletions(-)

A => testing/randproj2.sc
M testing/test_compiler.tuk
A => testing/randproj2.sc +152 -0
@@ 0,0 1,152 @@ 
+
+using import Array
+using import glm
+using import itertools
+
+import ..lib.tukan.use
+using import tukan.random
+using import tukan.color
+using import tukan.bitmap
+
+local rng : (Random)
+'seed rng 3
+
+#let z = 1.0
+#for i in (range 100)
+    %2 := z * z
+    %1 := ('random rng) * %2
+    %0 := %2 - %1
+    y := (sqrt %1) * ('sign rng)
+    x := (sqrt %0) * ('sign rng)
+    print x y
+
+let Q = 64
+N := Q * Q
+#T := 4096
+T := N
+local level0 : (Array i32)
+'resize level0 N
+local weights : (Array f32)
+'resize weights N 1.0
+
+fn coord (n)
+    _ (n % Q) (n // Q)
+fn index (x y)
+    ((y + Q) % Q) * Q + ((x + Q) % Q)
+
+fn moddist (a b q)
+    let d = (abs (a - b))
+    min d (q - d)
+
+fn... ansicolor (col : vec3)
+    let r g b = (unpack (ivec3 (* 255.0 (clamp col (vec3 0) (vec3 1)))))
+    r := (tostring r)
+    g := (tostring g)
+    b := (tostring b)
+    .. "\x1b[38;2;" r ";" g ";" b "m"
+
+local totalcount = 0.0
+for i in (range T)
+    if ((i % Q) == 0)
+        print "progress:" (i * 100 / T) "%"
+    let slots = ((countof level0) as i32)
+    #let k = ('random rng)
+    #let k = ((0.5 + phi * (i as f32)) % 1.0)
+    let k =
+        do
+            0.5
+    #let k =
+        'random rng
+        #do
+            let g = 1.32471795724474602596
+            let a1 = (1.0 / g)
+            let a2 = (1.0 / (g * g))
+            /
+                index
+                    (((0.5 + a1 * (i as f32)) % 1.0) * Q) as i32
+                    (((0.5 + a2 * (i as f32)) % 1.0) * Q) as i32
+                N
+    local totalweight = 0.0
+    local maxweight = 0.0
+    for w in weights
+        totalweight += w
+        maxweight = (max maxweight w)
+    #if (i == (T - 1))
+    #if (i == 16)
+        local prob = 0.0
+        for y in (range Q)
+            for x in (range Q)
+                n := y * Q + x
+                let w = ((weights @ n) / maxweight)
+                #let w = ((weights @ n) / totalweight)
+                prob += w
+                io-write!
+                    ansicolor (vec3 w)
+                    #ansicolor (vec3 prob)
+                io-write! "██"
+            io-write! "\n"
+        if true
+            exit 0
+
+    fold (w = 0.0) for n in (range slots)
+        let n = ('range rng slots)
+        let inthis = (weights @ n)
+        let prob = (inthis / totalweight)
+        #let prob = (1.0 / N)
+        let w = (w + prob)
+        if ((1.0 - (inthis / maxweight)) < 0.9)
+            level0 @ n = (i + 1)
+            let cx cy = (coord n)
+
+            let maxlen = (length (vec2 Q Q))
+
+            for i u in (enumerate weights)
+                let x y = (coord i)
+                let dx = ((moddist x cx Q) / Q)
+                let dy = ((moddist y cy Q) / Q)
+                let d = (length (vec2 dx dy))
+                d := d * 4.0
+                let g = (exp (- (d * d)))
+                let w = (1.0 - g)
+                u = (u / maxweight) * w
+                #u *= w
+            break w
+        w
+    totalcount += 1.0
+
+for y in (range Q)
+    fy := y / Q
+    for x in (range Q)
+        n := y * Q + x
+        let w = (viridis ((level0 @ n) / T))
+        io-write!
+            ansicolor w
+            #ansicolor (step fy w)
+        io-write! "██"
+    io-write! "\n"
+print (ansicolor (vec3 1)) "\n"
+
+#do
+    let outimage =
+        Bitmap4 (ivec2 Q Q)
+    for x y in (dim Q Q)
+        n := (index x y)
+        let src = (vec3 ((level0 @ n) / T))
+        let dst = ('fetch outimage x y)
+        let r g b = (unpack (ivec3 ((clamp src (vec3 0) (vec3 1)) * 255.0)))
+        dst @ 0 = r as u8
+        dst @ 1 = g as u8
+        dst @ 2 = b as u8
+        dst @ 3 = 255:u8
+    'save-png outimage (.. module-dir "/rpbluenoise.png")
+
+local minv = 0x7fffffff
+local maxv = 0
+local total = 0
+for i c in (enumerate level0)
+    minv = (min minv c)
+    maxv = (max maxv c)
+    total += c
+print "min" minv "max" maxv "total" total
+
+;
  No newline at end of file

          
M testing/test_compiler.tuk +56 -34
@@ 106,46 106,68 @@ fn topowalk (user root edgef visitf)
                                         self
                                 set self 'stack (pop stack)
     get self 'user
-fn stackvm (user f)
-    fn get-stacksize (self)
-        countof (get self 'stack)
-    fn pop (self)
-        last stack
-        set self 'stack (pop stack)        
-    fn push (self f)
-        set self 'stack
-            append (get self 'stack) f
+
+#
+    fn cc (f args)
+        let handler f
+        fn final (_ args)
+        let self
+            fold
+                cell f final args
+                65536
+                fn (self i)
+                    let@ f fret args self
+                    let f
+                        cond (== f true) handler f
+                    f fret args
+        get self 2
+
+    fn fib (fret n)
+        cond (< n 2)
+            cell fret false n
+            cell true
+                fn (_ n1)
+                    cell true
+                        fn (_ n2)
+                            cell fret false (dump (+ n1 n2))
+                        - n 2
+                - n 1
+    dump
+        cc fib 10
+
+fn cc (ftable start args)
+    let ftable
+        set ftable '__final__
+            fn (ctx ret args)
     let self
         fold
-            do
-                = stack (cell f)
-                = user user
-                = push push
+            cell (cell start (cell)) (cell '__final__ (cell)) args
             65536
             fn (self i)
-                let stack (get self 'stack)
-                let done? (empty? stack)
-                cond (not done?)
-                    do
-                        let f (last stack)
-                        let self (set self 'stack (pop stack))
-                        f self
-    get self 'user
-#fn fib-rec (f n)
-            cond (< n 2) n
-                +
-                    f f (- n 1)
-                    f f (- n 2)
-        fib-rec fib-rec 10
-fn fib (stack n)
-    cond (< n 2) n
-        push stack
-            fn (stack)
+                let@ f ret args self
+                let@ token ctx f
+                (get ftable token) ctx ret args
+    get self 2
 
 dump
-    stackvm (cell)
-        fn (stack)
-            fib stack n
+    cc
+        do
+            = fib
+                fn (ctx ret n)
+                    cond (< n 2)
+                        cell ret false n
+                        cell (cell 'fib (cell)) (cell 'fibc1 (cell ret (- n 2))) (- n 1)
+            = fibc1
+                fn (ctx _ n1)
+                    let@ ret n ctx
+                    cell (cell 'fib (cell)) (cell 'fibc2 (append ctx n1)) n
+            = fibc2
+                fn (ctx _ n2)
+                    let@ ret n n1 ctx
+                    cell ret false (+ n1 n2)
+        'fib
+        10
+
 #dump # prints (a b c d (c d) e f (a b (c d) d e (c d) f))
     topowalk (cell)
         quote (a b (c d) d e (c d) f)