2cf8c137bf94 — Leonard Ritter a month ago
* 2D voxel BVH implementation
4 files changed, 687 insertions(+), 3 deletions(-)

M lib/tukan/color.sc
A => testing/scrambleint.sc
M testing/test_node4.sc
A => testing/voxel_bvh.sc
M lib/tukan/color.sc +3 -3
@@ 38,7 38,7 @@ fn albedo-hue (h)
         materials blended in linear colorspace, particularly when using
         tonemapping.
     let h =
-        (fract (h + 0.92620819117478)) * 6.2831853071796
+        ((h + 0.92620819117478) % 1.0) * 6.2831853071796
     let cocg =
         0.25 * (vec2 (cos h) (sin h))
     let br = ((vec2 (- cocg.x) cocg.x) - cocg.y)

          
@@ 78,7 78,7 @@ fn smooth-hsv2rgb (c)
     c.z * (mix (vec3 1) rgb c.y)
 
 # ratio: 3 = neon, 4 = refracted, 5+ = approximate white
-fn physhue2rgb (hue ratio)
+#fn physhue2rgb (hue ratio)
     "vec3 <- (f32 f32)"
     smoothstep
         vec3 0

          
@@ 264,7 264,7 @@ do
         hsl2rgb
         hsv2rgb
         smooth-hsv2rgb
-        physhue2rgb
+        #physhue2rgb
         tonemap
         inverse_tonemap
         linear->sRGB

          
A => testing/scrambleint.sc +333 -0
@@ 0,0 1,333 @@ 
+
+import ..lib.tukan.use
+using import tukan.SHA256
+
+spice xorshift_inv_k32 (x)
+    x := (sc_const_int_extract x) as u32
+    k := (findmsb (32:u32 // x))
+    k := (? ((x << k) >= 32:u32) k (k + 1:u32))
+    sc_argument_list_map_new (k as i32)
+        inline (i)
+            (x << (i as u32))
+
+run-stage;
+
+#let u128 = (integer 128)
+#let aesenc = (extern 'llvm.x86.aesni.aesenc (function u128 u128 u128))
+# fails, but why?
+#print (aesenc (nullof u128) (nullof u128))
+
+#%res = call <2 x i64> @llvm.x86.aesni.aesenc(<2 x i64> %a0, <2 x i64> %a1)
+
+fn... mod_inverse_2 (a : u32)
+    x := (a * a) + a - 1
+    x := x * (2 - a * x)
+    x := x * (2 - a * x)
+    x := x * (2 - a * x)
+    x
+
+# Algorithm "xor" from p. 4 of Marsaglia, "Xorshift RNGs"
+fn... xorshift32 (x : u32)
+    x := x ^ (x << 13)
+    x := x ^ (x >> 17)
+    x := x ^ (x << 5)
+    x
+
+inline... xorshiftr (x : u32, y : u32)
+    x ^ (x >> y)
+
+inline... xorshiftl (x : u32, y : u32)
+    x ^ (x << y)
+
+# for any right xorshift by k, the inverse is a sequence of i right xorshifts
+    with shifts of 2**i * k = w for all w < bitwidth
+
+    the same goes for left xorshifts.
+    from https://marc-b-reynolds.github.io/math/2017/10/13/IntegerBijections.html
+inline... ixorshiftr (x : u32, y : u32)
+    va-lfold x
+        inline (k v x)
+            x ^ (x >> v)
+        xorshift_inv_k32 y
+
+inline... ixorshiftl (x : u32, y : u32)
+    va-lfold x
+        inline (k v x)
+            x ^ (x << v)
+        xorshift_inv_k32 y
+
+# from http://www.burtleburtle.net/bob/hash/integer.html
+    one of Thomas Wang's hash functions
+fn... wang-hash (seed : u32)
+    seed := (seed ^ 61:u32) ^ (seed >> 16:u32)
+    seed := seed * 9:u32
+    seed := seed ^ (seed >> 4:u32)
+    seed := seed * 0x27d4eb2d:u32
+    seed ^ (seed >> 15:u32)
+
+fn... murmurhash32_mix32 (x : u32)
+    x := x ^ (x >> 16)
+    x := x * 0x85ebca6b:u32
+    x := x ^ (x >> 13)
+    x := x * 0xc2b2ae35:u32
+    x := x ^ (x >> 16)
+    x
+
+# from https://nullprogram.com/blog/2018/07/31/
+fn... lowbias32 (x : u32)
+    x := x ^ (x >> 16)
+    x := x * 0x7feb352d:u32
+    x := x ^ (x >> 15)
+    x := x * 0x846ca68b:u32
+    x := x ^ (x >> 16)
+    x
+
+# inverse
+fn... lowbias32_r (x : u32)
+    x := x ^ (x >> 16)
+    x := x * 0x43021123:u32
+    x := x ^ (x >> 15 ^ x >> 30)
+    x := x * 0x1d69e2a5:u32
+    x := x ^ (x >> 16)
+    x
+
+# // exact bias: 0.020888578919738908
+fn... triple32 (x : u32)
+    x := x ^ (x >> 17)
+    x := x * 0xed5ad4bb:u32
+    x := x ^ (x >> 11)
+    x := x * 0xac4c1b51:u32
+    x := x ^ (x >> 15)
+    x := x * 0x31848bab:u32
+    x := x ^ (x >> 14)
+    x
+
+""""round x to the next highest power of 2
+inline... alignsizeu (x : u32)
+    x := x - 1
+    x := x | x >> 1
+    x := x | x >> 2
+    x := x | x >> 4
+    x := x | x >> 8
+    x := x | x >> 16
+    x + 1
+case (x : u64)
+    x := x - 1
+    x := x | x >> 1
+    x := x | x >> 2
+    x := x | x >> 4
+    x := x | x >> 8
+    x := x | x >> 16
+    x := x | x >> 32
+    x + 1
+
+""""extract the highest bit from x (round x to the next lowest power of 2)
+inline... alignsized (x : u32)
+    x := x | x >> 1
+    x := x | x >> 2
+    x := x | x >> 4
+    x := x | x >> 8
+    x := x | x >> 16
+    x & ((x >> 1) + 1)
+case (x : u64)
+    x := x | x >> 1
+    x := x | x >> 2
+    x := x | x >> 4
+    x := x | x >> 8
+    x := x | x >> 16
+    x := x | x >> 32
+    x & ((x >> 1) + 1)
+
+using import Array
+using import Set
+using import Rc
+using import enum
+local keys : (Array string)
+for scope in ('lineage (globals))
+    for k in scope
+        'append keys (k as Symbol as string)
+#va-map
+    inline (k)
+        'append keys k
+    \ "get_value" "set_value" "size" "__*" "__/" "__+" "__-"
+
+fn testmap (keys)
+    let PREFIXBITS = 11
+    let PREFIXCOUNT = (1 << PREFIXBITS)
+    let PREFIXMASK = (PREFIXCOUNT - 1)
+
+    enum Node
+        let Rc = (Rc this-type)
+        nothing
+        cell : string Rc
+
+    local slots : (Array Node.Rc)
+    let NIL = (Rc.wrap (Node.nothing))
+    for i in (range PREFIXCOUNT)
+        'append slots (copy NIL)
+
+    fn insert (node value numinserts)
+        numinserts += 1
+        let h = (hash value)
+        dispatch node
+        case nothing ()
+            return (Rc.wrap (Node.cell value (copy node)))
+        case cell (key next)
+            let h2 = (hash key)
+            if (h2 as integer > h as integer)
+                return (Rc.wrap (Node.cell value (copy node)))
+            else
+                return (Rc.wrap (Node.cell key (this-function next value numinserts)))
+        default
+            unreachable;
+
+    local numinserts = 0:u32
+    for key in keys
+        local h = (hash key)
+        let slot =
+            static-if (PREFIXBITS == 0) 0
+            else
+                h as integer >> (64 - PREFIXBITS)
+        #slot := h as integer & PREFIXMASK
+        assert (slot < PREFIXCOUNT)
+        let target = (slots @ slot)
+        target = (insert target key numinserts)
+
+    local worsthit = 0:u32
+    local besthit = -1:u32
+    local numhits = 0:u32
+    local searches : (Array u32)
+    for node in slots
+        loop (i d node = 0:u32 "" node)
+            dispatch node
+            case nothing ()
+                worsthit = (max worsthit i)
+                if (i == 0)
+                    print (.. d "-")
+                else
+                    besthit = (min besthit i)
+                break;
+            case cell (key next)
+                'append searches (i + 1)
+                numhits += (i + 1)
+                print (.. d (hex (hash key)))
+                repeat (i + 1) (.. d "  ") next
+            default
+                unreachable;
+    'sort searches
+    median := searches @ ((countof searches) // 2)
+    print "slots" PREFIXCOUNT "keys" ((countof keys) as i32) "load" ((countof keys) / PREFIXCOUNT) "log2" (log2 ((countof keys) as f32))
+    print "insert avg" (numinserts / (countof keys))
+    print "best" besthit "worst" worsthit "median" median "average" (numhits / (countof keys))
+
+fn testmap2 ()
+    let KEYCOUNT = 256:u32
+
+    let PREFIXBITS = 5
+    let PREFIXCOUNT = (1 << PREFIXBITS)
+    let PREFIXMASK = (PREFIXCOUNT - 1)
+
+    let MAXVALUE = (KEYCOUNT * 7)
+    print (findmsb (alignsizeu MAXVALUE))
+    fn hash (key)
+        key := (copy key)
+        #if (key == 0) key
+        #else
+            (key << (31 - (findmsb key))) << 1
+        key << 21
+        #key // MAXVALUE
+        #((triple32 key) << 4) | (key & 0xf)
+        #triple32 key
+
+    #n := 0b11011010:u32
+    #print (bin n) (bin (hash n))
+
+    enum Node
+        let Rc = (Rc this-type)
+        nothing
+        cell : u32 Rc
+
+    local slots : (Array Node.Rc)
+    let NIL = (Rc.wrap (Node.nothing))
+    for i in (range PREFIXCOUNT)
+        'append slots (copy NIL)
+
+    fn insert (node value numinserts)
+        numinserts += 1
+        let h = (hash value)
+        dispatch node
+        case nothing ()
+            return (Rc.wrap (Node.cell value (copy node)))
+        case cell (key next)
+            let h2 = (hash key)
+            if (h2 as integer < h as integer)
+                return (Rc.wrap (Node.cell value (copy node)))
+            else
+                return (Rc.wrap (Node.cell key (this-function next value numinserts)))
+        default
+            unreachable;
+
+    local numinserts = 0:u32
+    local numkeys = 0
+    for key in (range 0:u32 (KEYCOUNT * 7) 7)
+        numkeys += 1
+        local h = (hash key)
+        let slot =
+            static-if (PREFIXBITS == 0) 0
+            else
+                h as integer >> (32 - PREFIXBITS)
+                #h as integer & PREFIXMASK
+        assert (slot < PREFIXCOUNT)
+        let target = (slots @ slot)
+        target = (insert target key numinserts)
+
+    local worsthit = 0:u32
+    local besthit = -1:u32
+    local numhits = 0:u32
+    local searches : (Array u32)
+    for node in slots
+        loop (i d node = 0:u32 "" node)
+            dispatch node
+            case nothing ()
+                worsthit = (max worsthit i)
+                if (i == 0)
+                    print (.. d "-")
+                else
+                    besthit = (min besthit i)
+                break;
+            case cell (key next)
+                'append searches (i + 1)
+                numhits += (i + 1)
+                #print (.. d (hex (hash key)))
+                print (.. d (tostring key))
+                repeat (i + 1) (.. d "  ") next
+            default
+                unreachable;
+    'sort searches
+    median := searches @ ((countof searches) // 2)
+    print "slots" PREFIXCOUNT "keys" (KEYCOUNT as i32) "load" (KEYCOUNT / PREFIXCOUNT) "log2" (log2 (KEYCOUNT as f32))
+    print "insert avg" (numinserts / KEYCOUNT)
+    print "best" besthit "worst" worsthit "median" median "average" (numhits / KEYCOUNT)
+
+do
+    testmap keys
+    #testmap2;
+
+#do
+    print
+        ixorshiftl (xorshiftl 192384:u32 9:u32) 9:u32
+
+    let k = 65537:u32
+    let ik = (mod_inverse_2 k)
+    let m = 0x89abcdef:u32
+    print k ik (mod_inverse_2 ik) (k * ik)
+    print m (m * k) ((m * k) * ik)
+
+    fold (x = 1:u32) for i in (range 16:u32)
+        x := x * k
+        print x (x & 0xf)
+        x
+    #
+        i := (i << 1) | 1
+        print
+            (triple32 i) & 0xf

          
M testing/test_node4.sc +40 -0
@@ 193,6 193,46 @@ inline unpack_weakref (value)
 
 ################################################################################
 
+enum TypeKind : u32
+    Unknown = 0
+
+    # ±bitcount
+    Integer
+    # bitcount
+    Real
+    # element-type:ref size:u32
+    Vector
+    # element-type:ref size:u32
+    Array
+    # element-type:ref ... NULL
+    Tuple
+    # element-type:ref
+    Pointer
+    # type:ref map:ref map-type:ref
+        a map is a 2-tuple of a tuple of pointers to string keys and a
+        same-sized tuple of pointers to values that the keys map to. The
+        string keys need to be in lexicographic order.
+    Qualifier
+
+
+
+#
+    types:
+
+    each type starts with a pointer to a string id, followed by
+
+
+
+
+let bool32 = u32
+
+struct TypeInteger plain
+    width : u32
+
+
+
+################################################################################
+
 struct Module
     BitWordType := u64
     BitWordWidth := (bitcountof BitWordType)

          
A => testing/voxel_bvh.sc +311 -0
@@ 0,0 1,311 @@ 
+
+using import glm
+using import itertools
+using import Array
+
+import ..lib.tukan.use
+using import tukan.sdf
+using import tukan.File
+using import tukan.color
+using import tukan.rotation
+
+fn df (p)
+    op := p
+    p :=
+        versor-rotate
+            versor (vec3 0 0 1) (radians 45.0)
+            p
+    #sdOr
+        sdSub
+            sdSphere p 0.8
+            sdSphere (p - (vec3 0.3 -0.3 0)) 0.8
+        sdTorus (vec3 (p.x - 0.3) 0 (p.y + 0.3)) (vec2 0.4 0.1)
+    #sdOr
+        sdBox op (vec3 0.3)
+        sdSub
+            sdBox p (vec3 0.6)
+            sdSphere p 0.5
+    #sdSub
+        sdBox p (vec3 0.6)
+        sdBox op (vec3 0.4)
+    #fold (d = inf) for i x y in (enumerate (dim 4 4))
+        q := (((vec2 x y) / 3.0) * 2.0 - 1.0) * 0.8
+        sdOr d
+            sdSphere (p - (vec3 q 0)) (0.0625 + (i as f32 / 16.0) * 0.0625)
+    sdSmoothOr
+        sdTorus ((p - (vec3 -0.5 0 0)) . xzy) (vec2 0.35 0.05)
+        sdTorus ((p - (vec3 0.5 0 0)) . xzy) (vec2 0.35 0.05)
+        0.6
+
+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)
+
+fn sat@ (sat x y)
+    if ((x < 0) | (y < 0)) 0
+    else (deref (sat @ (index x y)))
+
+fn... volume (sat bounds)
+    let x1 y1 x2 y2 =
+        va-map
+            inline (x) (x - 1)
+            unpack bounds
+    p00 := (sat@ sat x1 y1)
+    p10 := (sat@ sat x2 y1)
+    p01 := (sat@ sat x1 y2)
+    p11 := (sat@ sat x2 y2)
+    p00 + p11 - p10 - p01
+case (bounds)
+    let x1 y1 x2 y2 = (unpack bounds)
+    let w h = (x2 - x1) (y2 - y1)
+    w * h
+
+fn diagvolume (bounds)
+    let x1 y1 x2 y2 = (unpack bounds)
+    let w h = (x2 - x1) (y2 - y1)
+    abs (w - h)
+
+fn sqvolume (bounds)
+    let x1 y1 x2 y2 = (unpack bounds)
+    let w h = (x2 - x1) (y2 - y1)
+    w * w + h * h
+
+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)
+        let d = (distmap @ (index x y))
+        io-write!
+            if (d <= 0) "Oo"
+            else "._"
+    io-write! "\n"
+
+for y in (range MAPDIM)
+    for x in (range MAPDIM)
+        let s = (sat @ (index x y))
+        if (s < 16)
+            io-write! "0"
+        io-write! (hex s)
+    io-write! "\n"
+
+fn tighten (sat bounds)
+    let v = (volume sat bounds)
+    let x1 y1 x2 y2 = (unpack bounds)
+    if (v == 0)
+        return (ivec4 x1 y1 x1 y1)
+    #assert (y2 > y1)
+    #assert (x2 > x1)
+    inline optimize (x1 x2 rnd cmpf vecf)
+        loop (l r = x1 x2)
+            x := (l + r + rnd) // 2
+            if ((r - l) <= 1)
+                break x
+            nv := (volume sat (vecf x))
+            if (cmpf nv v)
+                repeat l x
+            else
+                repeat x r
+    let x1 =
+        optimize x1 x2 0 (_ <) (inline (x) (ivec4 x y1 x2 y2))
+    let x2 =
+        optimize x1 x2 1 (_ >=) (inline (x) (ivec4 x1 y1 x y2))
+    #assert (x1 < x2) (.. (repr x1) " < " (repr x2))
+    let y1 =
+        optimize y1 y2 0 (_ <) (inline (y) (ivec4 x1 y x2 y2))
+    let y2 =
+        optimize y1 y2 1 (_ >=) (inline (y) (ivec4 x1 y1 x2 y))
+    #assert (y1 < y2) (.. (repr y1) " < " (repr y2))
+    ivec4 x1 y1 x2 y2
+
+let rootbounds = (ivec4 0 0 MAPDIM MAPDIM)
+let rootvolume = (volume sat rootbounds)
+let bounds = (tighten sat rootbounds)
+assert ((volume sat bounds) == rootvolume)
+assert (bounds == (tighten sat bounds))
+
+print "volume:" rootvolume
+print "tightened:" bounds "trim:" ((volume bounds) - rootvolume)
+
+let outp =
+    try (File.open (.. module-dir "/voxel_bvh.svg") "w")
+    else
+        error "failed to open file"
+
+fn write-string (outp str)
+    'write outp (str as rawstring) (countof str)
+
+write-string outp
+    """"<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+        <!-- Created with Inkscape (http://www.inkscape.org/) -->
+        <svg
+        xmlns:dc="http://purl.org/dc/elements/1.1/"
+        xmlns:cc="http://creativecommons.org/ns#"
+        xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+        xmlns:svg="http://www.w3.org/2000/svg"
+        xmlns="http://www.w3.org/2000/svg"
+        xmlns:xlink="http://www.w3.org/1999/xlink"
+        width="800"
+        height="800"
+        id="svg">
+
+        <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)
+    let dv = (volume sat bounds)
+    if (dv == 0) # empty
+        return;
+    #if (level > 3)
+        return;
+    let v = (volume bounds)
+    let trim = (v - 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
+        #let m = (level as f32 * 0.01)
+        write-string outp
+            .. "<rect x=\""
+                tostring (x1 as f32 + m)
+                "\" y=\""
+                tostring (y1 as f32 + m)
+                "\" width=\""
+                tostring (w as f32 - (2 * m))
+                "\" height=\""
+                tostring (h as f32 - (2 * m))
+                "\" fill=\""
+                do
+                    color := (viridis (level as f32 / 9.0))
+                    let color =
+                        if (trim == 0) color
+                        else (mix color (vec3 1.0) 0.5)
+                    let r g b = (unpack (color * 255.0))
+                    .. "rgb(" (tostring r) "," (tostring g) "," (tostring b) ")"
+                "\" stroke=\"#000000\" stroke-width=\"0.05px\"/>\n"
+    if (trim == 0) # done
+        return;
+
+    inline split (score b1 b2 r1 r2 splitf)
+        c := (r1 + r2) // 2
+        w := (r2 - r1 + 1) // 2
+        inline testsplit (w x bestscore b1 b2)
+            let lbounds rbounds = (splitf x)
+            let lbounds = (tighten sat lbounds)
+            let rbounds = (tighten sat rbounds)
+            let lb = (volume lbounds)
+            let lv = (volume sat lbounds)
+            let rb = (volume rbounds)
+            let rv = (volume sat rbounds)
+
+            let lsq = (sqvolume lbounds)
+            let rsq = (sqvolume rbounds)
+            #e0 := (abs (hv1 - hv2))
+            #e1 := (abs (vv1 - vv2))
+
+            #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 := (lb - lv) + (rb - rv)
+            #score := (lb / lv) ** 2 + (rb / rv) ** 2
+            #score := lv ** 2 + rv ** 2
+            #score := 1.0 / lv as f32 + 1.0 / rv as f32
+            #score := lb + rb + (lb - lv) ** 2 + (rb - rv) ** 2
+            #score := ((lb + rb) ** 2) - ((lv + rv) ** 2)
+            #score := (1.0 / lb as f32) + (1.0 / rb as f32) + (lb - lv) as f32 ** 2 + (rb - rv) as f32 ** 2
+            score as:= f32
+            if (score < bestscore)
+                _ score lbounds rbounds
+            else
+                _ bestscore b1 b2
+
+        fold (bestscore b1 b2 = score b1 b2)
+            \ for x in (range 0 w)
+            xl := (clamp (c - x - 1) r1 (r2 - 1))
+            xr := (clamp (c + x) r1 (r2 - 1))
+            testsplit x xl
+                testsplit x xr bestscore b1 b2
+
+    #let score b1 b2 =
+        if ((level & 1) == 0)
+            # horizontal split
+            split inf (ivec4 0) (ivec4 0) (y1 + 1) y2
+                inline (y)
+                    _ (ivec4 x1 y1 x2 y) (ivec4 x1 y x2 y2)
+        else
+            # vertical split
+            split inf (ivec4 0) (ivec4 0) (x1 + 1) x2
+                inline (x)
+                    _ (ivec4 x1 y1 x y2) (ivec4 x y1 x2 y2)
+
+
+    let b1 b2 =
+        do
+            # horizontal split
+            let hscore hb1 hb2 =
+                split inf (ivec4 0) (ivec4 0) (y1 + 1) y2
+                    inline (y)
+                        _ (ivec4 x1 y1 x2 y) (ivec4 x1 y x2 y2)
+            # vertical split
+            let vscore vb1 vb2 =
+                split inf (ivec4 0) (ivec4 0) (x1 + 1) x2
+                    inline (x)
+                        _ (ivec4 x1 y1 x y2) (ivec4 x y1 x2 y2)
+            if (hscore < vscore)
+                _ hb1 hb2
+            elseif (hscore > vscore)
+                _ vb1 vb2
+            #else
+                if ((level & 1) == 0)
+                    _ hb1 hb2
+                else
+                    _ vb1 vb2
+            else
+                let hv1 = (sqvolume hb1)
+                let hv2 = (sqvolume hb2)
+                let vv1 = (sqvolume vb1)
+                let vv2 = (sqvolume 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
+
+local numblocks = 0
+descend 0 sat (view outp) bounds numblocks
+
+write-string outp
+    """"</g>
+        </svg>
+drop outp
+
+print numblocks "blocks"
+
+;