c864c616134f — Leonard Ritter 2 months ago
* forgot to check in file
1 files changed, 266 insertions(+), 0 deletions(-)

A => testing/test_cadag_gui.sc
A => testing/test_cadag_gui.sc +266 -0
@@ 0,0 1,266 @@ 
+#!/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.DockGUI
+
+using import tukan.imgui
+using import tukan.nfd
+using import tukan.CADAG
+using import tukan.hash
+
+#-------------------------------------------------------------------------------
+
+# generate a new DAG module type
+let GUIDAG = (CADAG "GUIDAG")
+from GUIDAG let AnyId NoId
+do
+    from (methodsof GUIDAG) let define-type
+
+    define-type "str" (RIFF "TEXT") (tuple (chars = (array char)))
+    define-type "vbox" (RIFF "VBOX") (tuple (items = (array AnyId)))
+    define-type "hbox" (RIFF "HBOX") (tuple (items = (array AnyId)))
+
+    ;
+
+#-------------------------------------------------------------------------------
+
+struct App
+    module : GUIDAG
+    root : AnyId
+
+    # temporaries
+    rects : (Array vec4)
+
+global app : App
+
+#-------------------------------------------------------------------------------
+
+fn handle-gui-error (err)
+    print "error:" err
+
+#-------------------------------------------------------------------------------
+
+type AppDockGUI <:: DockGUI
+    from DockGUI let run handle-events __typecall on-frame draw
+
+    global test-window-visible = false
+    inline on-define-windows (self)
+        if test-window-visible
+            ShowDemoWindow test-window-visible
+
+    inline on-define-main-menu (self)
+        if (WithMenu "File")
+            #if (MenuItem "New Module")
+                local target_path : (mutable rawstring)
+                let result =
+                    NFD_SaveDialog "tuk"
+                        module-dir
+                        &target_path
+                if (result as integer == 1)
+                    try
+                        'new-module app target_path
+                    except (err)
+                        handle-gui-error err
+            #if (MenuItem "Open Module")
+                local target_path : (mutable rawstring)
+                let result =
+                    NFD_OpenDialog "tuk"
+                        module-dir
+                        &target_path
+                if (result as integer == 1)
+                    try
+                        'new-module app target_path
+                    except (err)
+                        handle-gui-error err
+        if (WithMenu "View")
+            MenuItem "Show Demo Window"
+                selected = test-window-visible
+            #on-define-view-menu;
+            #define-blocktree-view-menu;
+
+    inline on-define-dock (self)
+        'on-define-dock app self
+        #define-blocktree-dock;
+
+global dockgui =
+    AppDockGUI
+        title = "Tukan"
+        width = 960
+        height = 540
+        resizable = true
+
+inline set-value (arr id value)
+    idx := id as u32
+    if ((countof arr) <= idx)
+        'resize arr (idx + 1)
+    arr @ idx = value
+    ;
+
+type+ App
+    #fn on-module-changed (self)
+        let title =
+            if (empty? app.path) "Tukan"
+            else
+                .. app.path " - Tukan"
+        dockgui.glmain.title = title
+        ;
+
+    fn setup-test-dag (self)
+        from self let module
+        from (methodsof module.builder) let str vbox hbox
+        let longstr =
+            str "The quick brown fox jumped over the lazy dog"
+        let abcd =
+            hbox
+                str "A"
+                str "B"
+                str "C"
+                str "D"
+        self.root =
+            vbox longstr
+                hbox abcd abcd abcd
+                longstr
+        'dump module self.root
+        ;
+
+
+    fn on-define-dock (self dockgui)
+        # collect sizes
+        from self let rects module root
+        'clear rects
+        'descend module root
+            on-leave =
+                capture (module id) {&rects}
+                    let handle = ('handleof module id)
+                    inline get (id)
+                        rects @ id
+                    vvv bind size
+                    dispatch handle
+                    case str (str)
+                        vec4 0 0
+                            CalcTextSize (& (str.chars @ 0))
+                    case hbox (hbox)
+                        vec4 0 0
+                            fold (w h = 0.0 0.0) for src in ('sources handle)
+                                let __ __ cw ch = (unpack (get src))
+                                _ (w + cw) (max h ch)
+                    case vbox (vbox)
+                        vec4 0 0
+                            fold (w h = 0.0 0.0) for src in ('sources handle)
+                                let __ __ cw ch = (unpack (get src))
+                                _ (max w cw) (h + ch)
+                    default
+                        vec4 0
+                    set-value rects id size
+                    ;
+        WithBegin "GUIDAG";
+        #Text "second"
+        # draw rects
+        dl := (GetWindowDrawList)
+        do
+            let wp = (GetCursorScreenPos)
+            let x y w h = (unpack (rects @ root))
+            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) {&rects 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)
+                        rects @ id
+                    let rc = (get parentid)
+                    dispatch handle
+                    case hbox (hbox)
+                        if (index == 0)
+                            let pos = (rc.xy as vec2)
+                            let sz = (rc.zw as vec2)
+                            '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 vbox (vbox)
+                        if (index == 0)
+                            let pos = (rc.xy as vec2)
+                            let sz = (rc.zw as vec2)
+                            'AddRect dl pos (pos + sz) 0xff808080
+                        let src = (get (vbox.items @ index))
+                        src.x = rc.x
+                        src.y = rc.y
+                        rc.y += src.w
+                        ;
+                    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) {&rects dl &hstack}
+                    let hid = (deref hstack)
+                    #assert (not (hid in seen))
+                    #'insert seen hid
+                    let handle = ('handleof module id)
+                    inline get (id)
+                        rects @ id
+                    dispatch handle
+                    case str (str)
+                        let rc = (get id)
+                        let pos = (rc.xy as vec2)
+                        'AddText dl pos 0xffffffff (& (str.chars @ 0))
+                    default;
+                    ;
+        #'ChannelsMerge dl
+
+    fn init (self)
+        #on-module-changed self
+        'setup-test-dag self
+
+    #fn new-module (self path)
+        try
+            module :=
+                (Module.from-path path) as OptModule
+            self.path = (string path)
+            self.module = module
+            on-module-changed self
+        except (err)
+            self.module = none as OptModule
+            self.path = (string "")
+            on-module-changed self
+            raise err
+        ;
+
+#-------------------------------------------------------------------------------
+
+print "running main program"
+
+'init app
+'run dockgui
+    capture (event) {}
+    capture () {}
+
+print "done."
+
+