1f76611de99d — Leonard Ritter a month ago
* random bluenoise projection with probabilistic hierarchy
M lib/tukan/nanovg/init.sc +15 -2
@@ 39,15 39,25 @@ typedef NanoVG < Wrapper :: (mutable poi
         f;
         nvgRestore self
 
+    fn text-metrics (self)
+        local ascender : f32
+        local descender : f32
+        local lineh : f32
+        nvgTextMetrics self &ascender &descender &lineh
+        _ ascender descender lineh
+
+    inline... create-font (self, name, filename)
+        nvgCreateFont self name filename
+    case (self, name, filename, fontindex)
+        nvgCreateFontAtIndex self name filename fontindex
+
     let
-        create-font = nvgCreateFont
         begin-frame = nvgBeginGLFrame
         end-frame = nvgEndFrame
         begin-path = nvgBeginPath
         rect = nvgRect
         fill-color = nvgFillColor
         fill = nvgFill
-        text = nvgText
         circle = nvgCircle
         stroke-color = nvgStrokeColor
         stroke = nvgStroke

          
@@ 62,6 72,9 @@ typedef NanoVG < Wrapper :: (mutable poi
         translate = nvgTranslate
         rotate = nvgRotate
         scale = nvgScale
+        text = nvgText
+        font-face = nvgFontFaceId
+        font-size = nvgFontSize
 
 do
     let NanoVG

          
M testing/randproj.sc +1 -1
@@ 20,7 20,7 @@ local rng : (Random)
     x := (sqrt %0) * ('sign rng)
     print x y
 
-let Q = 256
+let Q = 64
 N := Q * Q
 #T := 4096
 T := N

          
A => testing/randproj_qt.sc +302 -0
@@ 0,0 1,302 @@ 
+
+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 712
+
+LEVELS := 5
+Q := (1 << LEVELS)
+N := Q * Q
+T := 3
+
+fn weights (u v)
+    # produce the nine weights for a given offset of a 2x2 sized sample
+        within a 3x3 grid
+    x0 := 0.5 - 0.5 * u
+    x1 := 0.5
+    x2 := 0.5 * u
+    y0 := 0.5 - 0.5 * v
+    y1 := 0.5
+    y2 := 0.5 * v
+    _
+        x0 * y0; x1 * y0; x2 * y0
+        x0 * y1; x1 * y1; x2 * y1
+        x0 * y2; x1 * y2; x2 * y2
+
+fn printweights (u v)
+    let a b c d e f g h i = (weights u v)
+    print a b c
+    print d e f
+    print g h i
+
+local levels : (Array (Array f32))
+'resize levels LEVELS
+for i in (range LEVELS)
+    N := (2 << i)
+    'resize (levels @ i) (N * N) 1.0
+    print i ":" N "*" N
+
+fn pick1 (levels level x y)
+    N := (2 << level)
+    assert (not ((x < 0) | (y < 0) | (x >= N) | (y >= N)))
+    m := levels @ level
+    copy (m @ (y * N + x))
+
+fn place1 (levels level x y v)
+    N := (2 << level)
+    if ((x < 0) | (y < 0) | (x >= N) | (y >= N))
+        return;
+    m := levels @ level
+    m @ (y * N + x) *= v
+    #print level "@" x y "+=" v
+    ;
+
+fn place (levels x y)
+    Qf := Q as f32
+    let u v =
+        (x as f32 + 0.5) / Qf; (y as f32 + 0.5) / Qf
+    for i in (rrange 0 LEVELS)
+        N := (2 << i) as f32
+        #w := (pow (N / Q) 0.25)
+        w := 1.0
+        xf := u * N
+        yf := v * N
+        su := xf - (floor xf)
+        sv := yf - (floor yf)
+        x := (xf as i32)
+        y := (yf as i32)
+        print N x y su sv w
+        inline tf (x)
+            1.0 - x * 2.0 * w
+        let p00 p10 p20 p01 p11 p21 p02 p12 p22 =
+            weights su sv
+        place1 levels i (x - 1) (y - 1) (tf p00)
+        place1 levels i x (y - 1) (tf p10)
+        place1 levels i (x + 1) (y - 1) (tf p20)
+        place1 levels i (x - 1) y (tf p01)
+        place1 levels i x y (tf p11)
+        place1 levels i (x + 1) y (tf p21)
+        place1 levels i (x - 1) (y + 1) (tf p02)
+        place1 levels i x (y + 1) (tf p12)
+        place1 levels i (x + 1) (y + 1) (tf p22)
+
+fn pick (levels rng)
+    let r = ('random rng)
+    fold (r x y = r 0 0) for i in (range 0 LEVELS)
+        x := x << 1
+        y := y << 1
+        v0 := (pick1 levels i x y)
+        v1 := (pick1 levels i x (y + 1))
+        v2 := (pick1 levels i (x + 1) y)
+        v3 := (pick1 levels i (x + 1) (y + 1))
+        #sum := 0.0
+        sum := (+ v0 v1 v2 v3)
+        let v0 v1 v2 v3 sum =
+            if (sum == 0)
+                _ 1.0 1.0 1.0 1.0 4.0
+            else
+                _ v0 v1 v2 v3 sum
+        a0 := (v0 / sum)
+        a1 := (v1 / sum)
+        a2 := (v2 / sum)
+        a3 := (v3 / sum)
+        w0 := a0
+        w1 := w0 + a1
+        w2 := w1 + a2
+        w3 := w2 + a3
+        if (r < w0)
+            _ (r / w0) x y
+        elseif (r < w1)
+            _ ((r - w0) / (w1 - w0)) x (y + 1)
+        elseif (r < w2)
+            _ ((r - w1) / (w2 - w1)) (x + 1) y
+        else
+            _ ((r - w2) / (w3 - w2)) (x + 1) (y + 1)
+
+local level0 : (Array i32)
+'resize level0 N
+
+#place levels 11 7
+for i in (range T)
+    let r x y = (pick levels rng)
+    print r x y
+    place levels x y
+    level0 @ (y * Q + x) = i
+
+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"
+
+do
+    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
+    L := 4
+    LQ := 2 << L
+    T := 1.0
+    for y in (range LQ)
+        for x in (range LQ)
+            vvv bind w
+            fold (w = 1.0) for i in (range LEVELS)
+                W := 2 << i
+                level := levels @ i
+                x := x >> (LEVELS - i - 1)
+                y := y >> (LEVELS - i - 1)
+                n := y * W + x
+                #w * (1.0 - (level @ n) * 2.0)
+                w * (level @ n)
+            #w := (viridis (w / ((1 * LEVELS) as f32)))
+            #w := (clamp w 0.0 1.0)
+            w := (viridis w)
+            io-write!
+                ansicolor w
+                #ansicolor (step fy w)
+            io-write! "██"
+        io-write! "\n"
+    print (ansicolor (vec3 1)) "\n"
+
+if true
+    exit 0
+
+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)
+
+local totalcount = 0.0
+phi := 2.0 / ((sqrt 5.0) + 1.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 =
+        #'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))
+        for y in (range Q)
+            for x in (range Q)
+                n := y * Q + x
+                let w = ((weights @ n) / maxweight)
+                io-write!
+                    ansicolor (vec3 w)
+                io-write! "██"
+            io-write! "\n"
+        if true
+            exit 0
+
+    fold (w = 0.0) for n in (range slots)
+        let inthis = (weights @ n)
+        let prob = (inthis / totalweight)
+        #let prob = (1.0 / N)
+        let w = (w + prob)
+        if (k < w)
+            level0 @ n = i
+            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))
+                #let phi = (sqrt 0.04)
+                #let phi = (sqrt 0.001)
+                #let phi = (sqrt 0.1)
+                #let phi = (sqrt 0.01)
+                let g =
+                    /
+                        exp
+                            /
+                                - (pow d 2.0)
+                                2.0 * phi * phi
+                        1.0 #phi * (sqrt tau)
+                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 = ((level0 @ n) / T)
+        io-write!
+            ansicolor w
+            #ansicolor (step fy w)
+        io-write! "██"
+    io-write! "\n"
+#print (ansicolor (vec3 1)) "\n"
+#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"
+
+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

          
A => testing/test_cadag_gui2.sc +278 -0
@@ 0,0 1,278 @@ 
+#!/usr/bin/env scopes
+
+using import struct
+using import glm
+
+using import Option
+using import Capture
+using import Map
+using import Set
+using import Array
+
+import ..lib.tukan.use
+using import tukan.GLMain
+using import tukan.sdl
+using import tukan.gl
+using import tukan.nanovg
+
+using import tukan.imgui
+using import tukan.nfd
+using import tukan.CADAG
+using import tukan.hash
+
+#-------------------------------------------------------------------------------
+
+let CELL_MARGIN = 2.0
+let CELL_ROUNDING = 3.0
+
+inline htmlcolor3 (value)
+    vec3
+        ((value >> 0) & 0xff:u32) / 0xff:u32
+        ((value >> 8) & 0xff:u32) / 0xff:u32
+        ((value >> 16) & 0xff:u32) / 0xff:u32
+
+let
+    BackgroundColor = (htmlcolor3 0x17191b)
+    TextColor = (htmlcolor3 0xc6c9c7)
+
+#-------------------------------------------------------------------------------
+
+# generate a new DAG module type
+let GUIDAG = (CADAG "GUIDAG")
+from GUIDAG let AnyId NoId
+do
+    from (methodsof GUIDAG) let define-type
+
+    define-type "text" (RIFF "TEXT") (tuple (chars = (array char)))
+    define-type "cell" (RIFF "CELL") (tuple (values = (array AnyId)))
+
+    ;
+
+#-------------------------------------------------------------------------------
+
+struct LayoutInfo plain
+    size : vec2 # original computed size
+    offset : vec2 # offset of the node within the current tree
+
+struct App
+    module : GUIDAG
+    root : AnyId
+    # column:line
+    cursor : uvec2
+    # pointer coordinates
+    #pointer : ivec2
+
+    # layout temporaries
+    layout : (Array LayoutInfo)
+    glmain =
+        GLMain
+            title = "Tukan"
+            width = 960
+            height = 540
+            resizable = true
+    vg = (NanoVG.create NanoVG.Antialias)
+    monofont : i32
+    sansfont : i32
+
+global app : App
+
+#-------------------------------------------------------------------------------
+
+fn handle-gui-error (err)
+    print "error:" err
+
+#-------------------------------------------------------------------------------
+
+inline set-value (arr id value)
+    idx := id as u32
+    if ((countof arr) <= idx)
+        'resize arr (idx + 1)
+    arr @ idx = value
+    ;
+
+type+ App
+    fn setup-test-dag (self)
+        from self let module
+        from (methodsof module.builder) let text cell
+        let longstr =
+            text "The quick brown fox jumped over the lazy dog"
+        let abcd =
+            cell
+                text "A"
+                text "B"
+                text "C"
+                text "D"
+        self.root =
+            cell longstr
+                cell abcd abcd abcd
+                longstr
+        'dump module self.root
+        ;
+
+
+    fn on-define-dock (self dockgui)
+        # collect sizes
+        WithBegin "GUIDAG";
+        PushFont dockgui.FixedFont
+        from self let layout module root
+        'clear layout
+        'descend module root
+            on-leave =
+                capture (module id) {&layout}
+                    let handle = ('handleof module id)
+                    inline get (id)
+                        layout @ id
+                    vvv bind size
+                    dispatch handle
+                    case text (text)
+                        CalcTextSize (& (text.chars @ 0))
+                    #case hbox (hbox)
+                        vec4 0 0
+                            fold (w h = 0.0 0.0) for src in ('sources handle)
+                                let l = (get src)
+                                _ (w + l.size.x) (max h l.size.y)
+                    case cell (cell)
+                        + (2 * CELL_MARGIN)
+                            vec2
+                                fold (w h = 0.0 0.0) for src in ('sources handle)
+                                    let x y = (unpack ((get src) . size))
+                                    _ (max w x) (h + y)
+                    default
+                        vec2 0
+                    set-value layout id
+                        LayoutInfo
+                            size = size
+                    ;
+        dl := (GetWindowDrawList)
+        do
+            let wp = (GetCursorScreenPos)
+            let x y = (unpack (layout @ root . offset))
+            x = wp.x
+            y = wp.y
+            ;
+
+        local hstack = 0:u64
+        #local seen : (Set u64)
+        'descend module root
+            on-enter-param =
+                capture (module parentid index id) {&layout dl &hstack}
+                    hstack =
+                        hpush (hpush hstack ((hash index) as integer))
+                            (hash id) as integer
+                    if (parentid == NoId)
+                        return true
+                    let handle = ('handleof module parentid)
+                    inline get (id)
+                        layout @ id
+                    let parentl = (get parentid)
+                    dispatch handle
+                    #case hbox (hbox)
+                        if (index == 0)
+                            let pos = parentl.offset
+                            let sz = parentl.size
+                            'AddRect dl pos (pos + sz) 0xff808080
+                        let src = (get (hbox.items @ index))
+                        src.x = rc.x
+                        src.y = rc.y
+                        rc.x += src.z
+                        ;
+                    case cell (cell)
+                        if (index == 0)
+                            let pos = parentl.offset
+                            let sz = parentl.size
+                            let margin = 1
+                            'AddRect dl pos (pos + sz) 0xff808080
+                                rounding = CELL_ROUNDING
+                        let src = (get (cell.values @ index))
+                        src.offset = parentl.offset + CELL_MARGIN
+                        parentl.offset.y += src.size.y
+                        ;
+                    default;
+                    true
+            on-leave-param =
+                capture (module parentid index id) {&hstack}
+                    hstack =
+                        hpop (hpop hstack ((hash id) as integer))
+                            (hash index) as integer
+                    ;
+            on-leave =
+                capture (module id) {&layout dl &hstack}
+                    let hid = (deref hstack)
+                    #assert (not (hid in seen))
+                    #'insert seen hid
+                    let handle = ('handleof module id)
+                    inline get (id)
+                        layout @ id
+                    dispatch handle
+                    case text (text)
+                        let l = (get id)
+                        let pos = l.offset
+                        'AddText dl pos 0xffffffff (& (text.chars @ 0))
+                    default;
+                    ;
+        #'ChannelsMerge dl
+        PopFont;
+
+    fn init (self)
+        from self let vg monofont sansfont
+        let fontsdir =
+            .. module-dir "/../share/tukan/fonts"
+        monofont =
+            'create-font vg "fixed"
+                .. fontsdir "/UbuntuMono-R.ttf"
+        sansfont =
+            'create-font vg "sans"
+                .. fontsdir "/DejaVuSans.ttf"
+        #on-module-changed self
+        'setup-test-dag self
+
+    fn step (self)
+        from self let vg glmain
+        let size = (deref glmain.size)
+        GL.BindFramebuffer GL.FRAMEBUFFER 0
+        from (methodsof vg) let begin-frame begin-path rect fill-color fill text
+            \ circle stroke-color stroke stroke-width end-frame font-face
+            \ font-size text-metrics
+
+        begin-frame size
+
+        begin-path;
+        rect 0 0 (unpack (vec2 size))
+        fill-color BackgroundColor
+        fill;
+
+        fill-color TextColor
+        font-size 12
+        font-face self.monofont
+        text 200 200 "The Quick Brown Fox Yadda Yadda" null
+
+        #
+            begin-path;
+            circle (f32 cursor.x) (f32 cursor.y) 8
+            stroke-color
+                vec3 1
+            stroke-width 4
+            stroke;
+            stroke-color
+                vec3 0
+            stroke-width 2
+            stroke;
+
+        end-frame;
+
+    fn run (self)
+        'init self
+        'run self.glmain
+            capture (event) {}
+            capture () {&self}
+                'step self
+
+#-------------------------------------------------------------------------------
+
+print "running main program"
+
+'run app
+
+print "done."
+
+

          
M testing/test_nanovg.sc +20 -18
@@ 27,31 27,33 @@ global cursor = (ivec2 100 100)
 
 fn render-view (size)
     GL.BindFramebuffer GL.FRAMEBUFFER 0
+    from (methodsof vg) let begin-frame begin-path rect fill-color fill text
+        \ circle stroke-color stroke stroke-width end-frame
 
-    'begin-frame vg size
+    begin-frame size
 
-    'begin-path vg
-    'rect vg 0 0 (unpack (vec2 size))
-    'fill-color vg
+    begin-path;
+    rect 0 0 (unpack (vec2 size))
+    fill-color
         vec3 0.5
-    'fill vg
-
-    'fill-color vg
-        vec3 0
-    'text vg 200 200 "The Quick Brown Fox Yadda Yadda" null
+    fill;
 
-    'begin-path vg
-    'circle vg (f32 cursor.x) (f32 cursor.y) 8
-    'stroke-color vg
+    fill-color
+        vec3 0
+    text 200 200 "The Quick Brown Fox Yadda Yadda" null
+
+    begin-path;
+    circle (f32 cursor.x) (f32 cursor.y) 8
+    stroke-color
         vec3 1
-    'stroke-width vg 4
-    'stroke vg
-    'stroke-color vg
+    stroke-width 4
+    stroke;
+    stroke-color
         vec3 0
-    'stroke-width vg 2
-    'stroke vg
+    stroke-width 2
+    stroke;
 
-    'end-frame vg
+    end-frame;
 
 capture on-event (event) {}
     if event.type == SDL_MOUSEMOTION