c3ad7f7367af — Leonard Ritter a month ago
* more work on voxel BVH
1 files changed, 99 insertions(+), 26 deletions(-)

M testing/voxel_bvh.sc
M testing/voxel_bvh.sc +99 -26
@@ 41,12 41,9 @@ let MAPDIM = 64
 
 local distmap : (Array f32)
 'resize distmap (MAPDIM * MAPDIM) 0.0
-# summed-area table
-local sat : (Array i32)
-'resize sat (MAPDIM * MAPDIM) 0
 
 fn index (x y)
-    (y % MAPDIM) * MAPDIM + (x % MAPDIM)
+    (mod y MAPDIM) * MAPDIM + (mod x MAPDIM)
 
 fn sat@ (sat x y)
     if ((x < 0) | (y < 0)) 0

          
@@ 82,19 79,16 @@ fn perimeter (bounds)
     let w h = (x2 - x1) (y2 - y1)
     2 * (w + h)
 
+fn sqaspect (bounds)
+    let x1 y1 x2 y2 = (unpack bounds)
+    let w h = (x2 - x1) (y2 - y1)
+    (w - h) ** 2
+
 for x y in (dim MAPDIM MAPDIM)
     p := ((vec2 x y) / (MAPDIM - 1)) * 2.0 - 1.0
     d := (df (vec3 p 0.0))
-    let sum =
-        -
-            +
-                (? (d <= 0) 1 0)
-                sat@ sat (x - 1) y
-                sat@ sat x (y - 1)
-            sat@ sat (x - 1) (y - 1)
     idx := (index x y)
     distmap @ idx = d
-    sat @ idx = sum
 
 for y in (range MAPDIM)
     for x in (range MAPDIM)

          
@@ 104,6 98,63 @@ for y in (range MAPDIM)
             else "._"
     io-write! "\n"
 
+local deltamap : (Array i32)
+'resize deltamap (MAPDIM * MAPDIM) 0
+
+for x y in (dim MAPDIM MAPDIM)
+    inline g (x y)
+        ? ((distmap @ (index x y)) <= 0) 1 0
+    #s00 := (g (x - 1) (y - 1))
+    s11 := (g x y)
+    idx := (index x y)
+    deltamap @ idx =
+        do
+            if (s11 == 1)
+                +
+                    va-map
+                        inline (x) (abs (s11 - x))
+                        g (x - 1) y
+                        g (x + 1) y
+                        g x (y - 1)
+                        g x (y + 1)
+            else 0
+
+for y in (range MAPDIM)
+    for x in (range MAPDIM)
+        let s = (deltamap @ (index x y))
+        if (s < 16)
+            io-write! "0"
+        io-write! (hex s)
+    io-write! "\n"
+
+inline makesat (dst src qf)
+    for x y in (dim MAPDIM MAPDIM)
+        idx := (index x y)
+        d := (src @ idx)
+        let sum =
+            -
+                +
+                    qf d
+                    sat@ dst (x - 1) y
+                    sat@ dst x (y - 1)
+                sat@ dst (x - 1) (y - 1)
+        dst @ idx = sum
+
+# summed-area table - volume
+local sat : (Array i32)
+'resize sat (MAPDIM * MAPDIM) 0
+
+makesat sat distmap
+    inline (d)
+        ? (d <= 0) 1 0
+
+# summed-area table - perimeter
+local sat2 : (Array i32)
+'resize sat2 (MAPDIM * MAPDIM) 0
+
+makesat sat2 deltamap
+    inline (d) d
+
 for y in (range MAPDIM)
     for x in (range MAPDIM)
         let s = (sat @ (index x y))

          
@@ 112,6 163,8 @@ for y in (range MAPDIM)
         io-write! (hex s)
     io-write! "\n"
 
+################################################################################
+
 fn tighten (sat bounds)
     let v = (volume sat bounds)
     let x1 y1 x2 y2 = (unpack bounds)

          
@@ 175,7 228,7 @@ write-string outp
         <rect x="0" y="0" width="800" height="800" fill="white"/>
         <g transform="scale(12.5,12.5) translate(0,0)">
 
-fn descend (level sat outp bounds numblocks)
+fn descend (level sat sat2 outp bounds numblocks maxlevel)
     let dv = (volume sat bounds)
     if (dv == 0) # empty
         return;

          
@@ 183,12 236,13 @@ fn descend (level sat outp bounds numblo
         return;
     let v = (volume bounds)
     let trim = (v - dv)
-    print "level" level "bounds" bounds "trim" trim "volume" dv
+    #print "level" level "bounds" bounds "trim" trim "volume" dv
     let x1 y1 x2 y2 = (unpack bounds)
     let w h = (x2 - x1) (y2 - y1)
     let m = 0.0
     do  #if (((level % 2) == 0) | (trim == 0))
         numblocks += 1
+        maxlevel = (max maxlevel level)
         #let m = (level as f32 * 0.01)
         write-string outp
             .. "<rect x=\""

          
@@ 226,6 280,9 @@ fn descend (level sat outp bounds numblo
             let rb = (volume rbounds)
             let rv = (volume sat rbounds)
 
+            let lo = (volume sat2 lbounds)
+            let ro = (volume sat2 rbounds)
+
             let lsq = (sqvolume lbounds)
             let rsq = (sqvolume rbounds)
 

          
@@ 237,10 294,25 @@ fn descend (level sat outp bounds numblo
             #score := lsq + rsq + ((lb - lv) + (rb - rv)) ** 2
             #score := (sqrt ((lsq + rsq) as f32)) + ((lb - lv) ** 2 + (rb - rv) ** 2) as f32
             let lm rm = (lb - lv) (rb - rv)
-            #score := lm ** 2 + rm ** 2 #+ lm * rm
-            score := lm ** 2 + rm ** 2 + lm * rm * w
+            #score := lm ** 2 + rm ** 2
+
+            let lbb rbb = (lp - lo) (rp - ro)
+            score :=
+                min
+                    lm ** 2 + rm ** 2
+                    +
+                        (lo - ro) ** 2
+                        lbb ** 2 + rbb ** 2
+            #score := lm ** 2 + rm ** 2
+            #score := (lo - ro) ** 2 + lbb ** 2 + rbb ** 2
+            #score := (lo - ro) ** 2
+
+            #score := lm ** 2 + rm ** 2 + (lv - rv) ** 2 #+ lm * rm
+            #score := (lm - rm) ** 2 + lm ** 2 + rm ** 2
+            #score := (lp - rp) ** 2
             #score := (lb / b) ** 2 + (rb / b) ** 2
             #score := lm * rm * w
+            #score := (lb - rb) ** 2
 
             #score := (lb - lv) + (rb - rv)
             #score := (lb / lv) ** 2 + (rb / rv) ** 2

          
@@ 297,29 369,30 @@ fn descend (level sat outp bounds numblo
                 else
                     _ vb1 vb2
             else
-                let hv1 = (perimeter hb1)
-                let hv2 = (perimeter hb2)
-                let vv1 = (perimeter vb1)
-                let vv2 = (perimeter vb2)
-                e0 := hv1 ** 2 + hv2 ** 2
-                e1 := vv1 ** 2 + vv2 ** 2
+                let hv1 = (sqaspect hb1)
+                let hv2 = (sqaspect hb2)
+                let vv1 = (sqaspect vb1)
+                let vv2 = (sqaspect vb2)
+                e0 := hv1 + hv2
+                e1 := vv1 + vv2
                 if (e0 < e1)
                     _ hb1 hb2
                 else
                     _ vb1 vb2
 
     level := level + 1
-    this-function level sat outp b1 numblocks
-    this-function level sat outp b2 numblocks
+    this-function level sat sat2 outp b1 numblocks maxlevel
+    this-function level sat sat2 outp b2 numblocks maxlevel
 
 local numblocks = 0
-descend 0 sat (view outp) bounds numblocks
+local maxlevel = 0
+descend 0 sat sat2 (view outp) bounds numblocks maxlevel
 
 write-string outp
     """"</g>
         </svg>
 drop outp
 
-print numblocks "blocks"
+print numblocks "blocks," (maxlevel + 1) "levels"
 
 ;