Update to fennel 1.0, updated inspector

editor/imgui.fnl

@@ -0,0 +1,389 @@
+(local core (require :core))
+(local config (require :core.config))
+(local command (require :core.command))
+(local keymap (require :core.keymap))
+(local style (require :core.style))
+(local lume (require :lib.lume))
+
+(fn attach-imstate [view]
+  (set view.imstate {})
+  (fn view.on_mouse_pressed [self button x y clicks]
+    (tset self.imstate button :pressed)
+    (self.__index.on_mouse_pressed self button x y clicks))
+  (fn view.on_mouse_released [self button x y]
+    (tset self.imstate button :released)
+    (self.__index.on_mouse_released self button x y))
+  (fn view.on_key_pressed [self key]
+    (when (= self.imstate.keys nil)
+      (set self.imstate.keys []))
+    (table.insert self.imstate.keys key))
+  (fn view.on_text_input [self text]
+    (set self.imstate.text (.. (or self.imstate.text "") text))
+    (self.__index.on_text_input self text))
+  (fn view.form [self ?overrides]
+    (lume.merge {:x (+ self.position.x style.padding.x (- self.scroll.x))
+                 :y (+ self.position.y style.padding.y (- self.scroll.y))
+                 :w (- self.size.x (* style.padding.x 2))
+                 :view self}
+                (or ?overrides {})))
+  (fn view.end-scroll [self {: y : h}]
+    (let [pin-to-bottom (>= self.scroll.to.y (- self.scrollheight self.size.y))]
+      (set self.scrollheight (- (+ y (or h 0) style.padding.y) (+ self.position.y style.padding.y (- self.scroll.y))))
+      (when pin-to-bottom (set self.scroll.to.y (- self.scrollheight self.size.y)))))
+  (fn view.draw [self]
+    (set self.cursor nil)
+    (self.__index.draw self)
+    (when self.imstate.postponed
+      (each [_ action (ipairs self.imstate.postponed)]
+        (action))
+      (set self.imstate.postponed nil))
+    (when (= self.cursor nil) (set self.cursor :arrow))
+    (set self.imstate.keys nil)
+    (set self.imstate.text nil)
+    (when (= self.imstate.left :released)
+      (set self.imstate.active nil))
+    (each [_ button (pairs [:left :middle :right])]
+      (tset self.imstate button
+        (match (. self.imstate button)
+          :pressed  :down
+          :down     :down
+          :released nil)))))
+
+(fn register-keys [keys]
+  (local commands {})
+  (local keymaps {})
+  (each [_ key (ipairs keys)]
+    (local command-name (.. "imstate:" key))
+    (tset commands command-name #(core.active_view:on_key_pressed key))
+    (tset keymaps key command-name))
+  (command.add #(not= (-?> core.active_view.imstate (. :focus)) nil) commands)
+  (keymap.add keymaps))
+
+(register-keys [:backspace :delete :left :right :shift+left :shift+right :home :end :shift+home :shift+end
+                :ctrl+left :ctrl+right :ctrl+shift+left :ctrl+shift+right :ctrl+c :ctrl+v])
+
+(fn cmd-predicate [p]
+  (var p-fn p)
+  (when (= (type p-fn) :string) (set p-fn (require p-fn)))
+  (when (= (type p-fn) :table)
+    (local cls p-fn)
+    (set p-fn (fn [] (core.active_view:is cls))))
+  (fn [] (when (= (-?> core.active_view.imstate (. :focus)) nil)
+           (p-fn))))
+
+(fn postpone [view f]
+  (when (= view.imstate.postponed nil)
+    (set view.imstate.postponed []))
+  (table.insert view.imstate.postponed f))
+
+(fn make-tag [tag]
+  (match (type tag)
+    :string tag
+    :table  (table.concat tag "::")
+    _       (tostring tag)))
+
+(fn mouse-inside [x y w h]
+  (local (mx my) (values (love.mouse.getX) (love.mouse.getY)))
+  (and (>= mx x) (<= mx (+ x w)) (>= my y) (<= my (+ y h))))
+
+(fn consume-pressed [view button]
+  (when (= (. view.imstate button) :pressed)
+    (tset view.imstate button :down)
+    true))
+
+(fn activate [{: view : tag : x : y : w : h}]
+  (when (and (mouse-inside x y w h) (consume-pressed view :left))
+    (set view.imstate.active (make-tag tag))
+    true))
+
+(fn set-cursor [view cursor]
+  (when (= view.cursor nil) (set view.cursor cursor)))
+
+;; styling and layout
+(fn form-defaults [form k v ...]
+  (when (= (. form k) nil)
+    (let [v (if (= (type v) :function) (v form) v)]
+      (tset form k v)))
+  (if (>= (select :# ...) 2) (form-defaults form ...)
+    (do (when form.tag (set form.tag (make-tag form.tag))) ; fix up tag
+        form)))
+
+(fn with-style [form ...]
+  (form-defaults form :font style.font :color style.text :xpad style.padding.x :ypad style.padding.y ...))
+
+(local form-preserved-keys (collect [_ key (ipairs [:view :x :y :font :color :xpad :ypad])] key true))
+(fn reform [form overrides]
+  (if (and overrides overrides.into (not= overrides.into form))
+    (reform (lume.extend (lume.clear overrides.into) form) overrides)
+    (do (each [key (pairs form)]
+          (when (= (. form-preserved-keys key) nil)
+            (tset form key nil)))
+        (lume.extend form (or overrides {})))))
+
+(fn under [form overrides]    (reform form (lume.merge (or overrides {}) {:y (+ form.y (or form.h 0) (or form.ypad 0))})))
+(fn right-of [form overrides] (reform form (lume.merge (or overrides {}) {:x (+ form.x (or form.w 0) (or form.xpad 0))})))
+
+(fn group-wrapper [orig-form]
+  (let [group {}
+        update-dimension
+        (fn [form coord-key size-key]
+          (let [coord-group (. group coord-key) size-group (. group size-key)
+                coord-form (. form coord-key)   size-form (. form size-key)]
+            (if (= size-form nil) ; tried to add an unsized value to the group, ignore
+                nil
+
+                (= coord-group nil) ; container takes on the size of its first item
+                (do (tset group coord-key coord-form)
+                    (tset group size-key size-form))
+
+                (> coord-group coord-form) ; we have an item that is outside the bounds to the left / up; reduce the starting point and extend the size
+                (do (tset group coord-key coord-form)
+                    (tset group size-key (- (math.max (+ coord-form size-form) (+ coord-group size-group)) coord-form)))
+
+              ; extend the size if the new item is outside the bounds to the right / down
+              (tset group size-key (- (math.max (+ coord-form size-form) (+ coord-group size-group)) coord-group)))
+            form))
+        update-dimensions (fn [form] (update-dimension form :x :w) (update-dimension form :y :h))]
+
+    (fn [?viewfn-or-form ?form ...]
+      (match [(type ?viewfn-or-form) ?viewfn-or-form]
+        [:function viewfn] (let [result [(viewfn ?form ...)]]
+                             (update-dimensions ?form)
+                             (table.unpack result))
+        [:table form]      (update-dimensions form)
+        [:nil]             (lume.extend orig-form group)))))
+
+(fn horiz-wrapper [{:x orig-x :w orig-w}]
+  (fn [{: x : y : w : h : xpad : ypad &as form} overrides]
+    (if (> (+ x (or w 0) xpad (or w 0)) (+ orig-x orig-w))
+      (reform form (lume.merge (or overrides {}) {:x orig-x :y (+ y (or h 0) (or ypad 0))}))
+      (right-of form overrides))))
+
+;; widgets and widget helpers
+(fn active? [view tag] (= view.imstate.active (make-tag tag)))
+(fn button [{: view : tag : x : y : w : h &as form}]
+  (when (mouse-inside x y w h) (set-cursor view :hand))
+  (activate form)
+  (and (active? view tag) (= view.imstate.left :released) (mouse-inside x y w h)))
+
+(fn label [form text]
+  (let [(_ newlines) (text:gsub "\n" "\n")
+        text-height (fn [font] (* (font:get_height) (+ newlines 1)))
+        {: x : y : w : h : halign : valign : font : color}
+        (with-style form
+                    :w #($1.font:get_width text)
+                    :h #(text-height $1.font)
+                    :halign :left
+                    :valign :center)
+        x (match halign :left x :center (+ x (/ (- w (font:get_width text)) 2)) :right (+ x w (- (font:get_width text))))
+        y (match valign :top y :center (+ y (/ (- h (text-height font)) 2)) :bottom (+ y h (- (text-height font))))]
+    (renderer.draw_text font text x y color)))
+
+(fn textbutton [form label]
+  (let [{: x : y : w : h : xpad : ypad : font : color : bg}
+        (with-style form
+                    :bg style.selection
+                    :tag label
+                    :w #(+ ($1.font:get_width label) $1.xpad)
+                    :h #(+ ($1.font:get_height) $1.ypad))]
+    (renderer.draw_rect x y w h bg)
+    (renderer.draw_text font label (+ x (/ xpad 2)) (+ y (/ ypad 2)) color)
+    (button form)))
+
+(fn checkbox [form name isset]
+  (let [{: x : y : w : h : font : color : x-label}
+        (with-style form
+                    :tag name
+                    :h (* 12 SCALE)
+                    :x-label #(+ $1.x $1.h $1.xpad)
+                    :w #(+ $1.x-label ($1.font:get_width name)))]
+    (love.graphics.rectangle (if isset :fill :line) x y h h)
+    (renderer.draw_text font name x-label y color)
+    (love.graphics.setColor 1 1 1 1)
+    (button form))) ; whose idea was this?? should return (not isset) >:/
+
+(fn focused? [view tag] (= (make-tag tag) (-?> view.imstate.focus (. :tag))))
+(fn focus [{: view : tag : x : y : w : h &as form} opts]
+  (if (activate form)
+      (set view.imstate.focus
+        (doto (lume.clone (or opts {}))
+          (tset :tag (make-tag tag))))
+
+      (and (= view.imstate.left :released) (focused? view tag) (not (mouse-inside x y w h)))
+      (set view.imstate.focus nil))
+  (focused? view tag))
+
+  (local blink_period 0.8)
+(fn x-from-i [s i xLeft font]
+  (if (or (<= i 1) (= s "")) xLeft
+      (x-from-i (s:sub 2) (- i 1) (+ xLeft (font:get_width (s:sub 1 1))) font)))
+(fn i-from-x [s x xLeft font ?i]
+  (local i (or ?i 1))
+  (local w (font:get_width (s:sub 1 1)))
+  (local xMid (+ xLeft (/ w 2)))
+  (if (or (<= x xMid) (= s "")) i
+      (i-from-x (s:sub 2) x (+ xLeft w) font (+ i 1))))
+
+(fn next-match [text i di pred]
+  (local imax (+ (length text) 1))
+  (local inext (+ i di))
+  (if (<= inext 1) 1
+      (> inext imax) imax
+      (pred (text:sub inext inext)) (if (< di 0) i inext)
+    (next-match text inext di pred)))
+(fn is-nonword-char [char] (config.non_word_chars:find char nil true))
+(fn next-word [text i di]
+  (let [iwordboundary (next-match text i di #(is-nonword-char $1))]
+    (next-match text iwordboundary di #(not (is-nonword-char $1)))))
+
+(fn textnav [key i text]
+  (local imax (+ (length text) 1))
+  (match key
+    :left       (math.max 1 (- i 1))
+    :right      (math.min imax (+ i 1))
+    :ctrl+left  (next-word text i -1)
+    :ctrl+right (next-word text i 1)
+    :home       1
+    :end        imax))
+
+(fn selection-span [view]
+  (let [f       view.imstate.focus
+        iStart  (math.min f.i f.iAnchor)
+        iLim    (math.max f.i f.iAnchor)]
+    (values iStart iLim)))
+(fn selection-text [view text]
+  (local (iStart iLim) (selection-span view))
+  (text:sub iStart (- iLim 1)))
+
+(fn replace-selection [view s replacement ?iStart ?iLim]
+  (local (iStart iLim) (if ?iLim (values ?iStart ?iLim) (selection-span view)))
+  (local text
+    (.. (s:sub 1 (- iStart 1))
+        replacement
+        (s:sub iLim)))
+  (local iNew (+ iStart (length replacement)))
+  (set view.imstate.focus.i iNew)
+  (set view.imstate.focus.iAnchor iNew)
+  text)
+
+(fn textbox [form text]
+  (local {: font : color : w : h : x : y : xpad : ypad : color : view : tag}
+         (with-style form :h #(+ ($1.font:get_height) $1.ypad)))
+  (var textNew (or text ""))
+  (local (hText xText yText) (values (font:get_height) (+ x (/ xpad 2)) (+ y (/ ypad 2))))
+  (local initial-press (= view.imstate.left :pressed))
+
+  ; handle key events
+  (when (focus form {:i 1 :iAnchor 1 :blink (love.timer.getTime)})
+    (local f view.imstate.focus)
+    (when (> f.i (+ (length textNew) 1))       (set f.i (+ (length textNew) 1)))
+    (when (> f.iAnchor (+ (length textNew) 1)) (set f.iAnchor (+ (length textNew) 1)))
+    (when view.imstate.text
+      (set textNew (replace-selection view textNew view.imstate.text)))
+    (each [_ key (ipairs (or view.imstate.keys []))]
+      (set view.imstate.focus.blink (love.timer.getTime))
+      (if (= key :ctrl+c) (system.set_clipboard (selection-text view textNew))
+          (= key :ctrl+v) (set textNew (replace-selection view textNew (system.get_clipboard)))
+          (key:find "shift%+") (set f.i (or (textnav (key:gsub "shift%+" "") f.i textNew) f.i))
+        (let [iNav (textnav key f.i textNew)]
+          (when iNav
+            (set f.i iNav)
+            (set f.iAnchor iNav))
+          (when (or (= key :delete) (= key :backspace))
+            (local (iStartDel iLimDel)
+              (if (not= f.i f.iAnchor) (selection-span view)
+                  (= key :delete)      (values f.i (+ f.i 1))
+                  (= key :backspace)   (values (math.max 1 (- f.i 1)) f.i)))
+            (set textNew (replace-selection view textNew "" iStartDel iLimDel)))))))
+
+  ; handle mouse events
+  (when (mouse-inside x y w h) (set-cursor view :ibeam))
+  (when (and (focused? view tag) (active? view tag) (mouse-inside x y w h))
+    (local mouse-i (i-from-x textNew (love.mouse.getX) x style.font))
+    (when initial-press
+      (set view.imstate.focus.iAnchor mouse-i))
+    (set view.imstate.focus.i mouse-i))
+
+  ; draw box
+  (love.graphics.setLineWidth 1)
+  (love.graphics.rectangle :line x y w h)
+  (if (focused? view tag)
+    ; draw text with selection + caret
+    (let [(iStart iLim) (selection-span view)
+          xSelect (renderer.draw_text font (textNew:sub 1 (- iStart 1)) xText yText color)
+          sSelect (textNew:sub iStart (- iLim 1))
+          wSelect (font:get_width sSelect)
+          xTail   (+ xSelect wSelect)]
+      (when (> wSelect 0)
+        (renderer.draw_rect xSelect yText wSelect hText style.selection)
+        (renderer.draw_text font sSelect xSelect yText color))
+      (renderer.draw_text font (textNew:sub iLim) xTail yText color)
+      (when (or (active? view tag)
+                 (< (% (- (love.timer.getTime) view.imstate.focus.blink) (* blink_period 2)) blink_period))
+         (renderer.draw_rect (x-from-i textNew view.imstate.focus.i xText font) yText style.caret_width hText style.caret)))
+    ; just draw the text
+    (renderer.draw_text font textNew xText yText color))
+  (love.graphics.setColor 1 1 1)
+  textNew)
+
+(fn textfield [form label text]
+  (let [{: x : y : w : wlabel : wtext : font : color}
+        (with-style form :wlabel #(+ ($1.font:get_width label) $1.xpad)
+                         :wtext (* 150 SCALE)
+                         :w #(+ $1.wlabel $1.wtext)
+                         :tag label)
+        form-textbox (lume.merge form {:w wtext :x (+ x wlabel)})
+        _ (renderer.draw_text font label x y color)
+        text (textbox form-textbox text)]
+    (set form.h form-textbox.h)
+    text))
+
+(fn option-text [option]
+  (match (type option)
+    :string option
+    :table (or option.label (tostring option))
+    _ (tostring option)))
+
+(fn dropdown [form selection options]
+  (let [{: x : y : w :h row-h : font : color : bg : xpad : ypad : view : tag}
+        (with-style form :w (* 150 SCALE)
+                         :h #(+ ($1.font:get_height) $1.ypad)
+                         :bg style.selection)]
+    (var new-selection nil)
+
+    (renderer.draw_rect x y w row-h bg)
+    (renderer.draw_text style.font (option-text selection) (+ x xpad) (+ y (/ ypad 2)) color)
+    (renderer.draw_text style.icon_font "-" (+ x w (- xpad)) (+ y (/ ypad 2)) color)
+
+    (when (focused? view tag)
+      (var row-y (+ y row-h))
+      (each [i option (ipairs options)]
+        (when (button (lume.merge form {:tag [(make-tag tag) i] :y row-y}))
+          (set new-selection option))
+        (set row-y (+ row-y row-h)))
+      (postpone view (fn []
+         (var row-y (+ y row-h))
+         (each [i option (ipairs options)]
+           (renderer.draw_rect x row-y w row-h bg)
+           (renderer.draw_text font (option-text option) (+ x xpad) (+ row-y (/ ypad 2)) color)
+         (set row-y (+ row-y row-h))))))
+    (focus form)
+    (or new-selection selection)))
+
+(fn labelled-dropdown [form label selection options]
+  (let [{: x : y : wlabel : wdropdown : font : color}
+        (with-style form :wlabel #(+ ($1.font:get_width label) $1.xpad)
+                         :wdropdown (* 150 SCALE)
+                         :w #(+ $1.wlabel $1.wdropdown)
+                         :tag label)
+        form-dropdown (lume.merge form {:x (+ x wlabel) :w wdropdown})
+        _ (renderer.draw_text font label x y color)
+        selection (dropdown form-dropdown selection options)]
+    (set form.h form-dropdown.h)
+    selection))
+
+{: attach-imstate : cmd-predicate : postpone : mouse-inside : activate : active?
+ : button : checkbox : textbox : textfield : textbutton : dropdown : labelled-dropdown : label
+ : reform : under : right-of : horiz-wrapper : group-wrapper
+ : with-style : form-defaults}
+

editor/imstate.fnl

@@ -1,217 +0,0 @@
-(local core (require :core))
-(local config (require :core.config))
-(local command (require :core.command))
-(local keymap (require :core.keymap))
-(local style (require :core.style))
-(local lume (require :lib.lume))
-
-(fn attach-imstate [view]
-  (set view.imstate {})
-  (fn view.on_mouse_pressed [self button x y clicks]
-    (tset self.imstate button :pressed)
-    (self.__index.on_mouse_pressed self button x y clicks))
-  (fn view.on_mouse_released [self button x y]
-    (tset self.imstate button :released)
-    (self.__index.on_mouse_released self button x y))
-  (fn view.on_key_pressed [self key]
-    (when (= self.imstate.keys nil)
-      (set self.imstate.keys []))
-    (table.insert self.imstate.keys key))
-  (fn view.on_text_input [self text]
-    (set self.imstate.text (.. (or self.imstate.text "") text))
-    (self.__index.on_text_input self text))
-  (fn view.draw [self]
-    (set self.cursor nil)
-    (self.__index.draw self)
-    (when (= self.cursor nil) (set self.cursor :arrow))
-    (set self.imstate.keys nil)
-    (set self.imstate.text nil)
-    (when (= self.imstate.left :released)
-      (set self.imstate.active nil))
-    (each [_ button (pairs [:left :middle :right])]
-      (tset self.imstate button
-        (match (. self.imstate button)
-          :pressed  :down
-          :down     :down
-          :released nil)))))
-
-(fn register-keys [keys]
-  (local commands {})
-  (local keymaps {})
-  (each [_ key (ipairs keys)]
-    (local command-name (.. "imstate:" key))
-    (tset commands command-name #(core.active_view:on_key_pressed key))
-    (tset keymaps key command-name))
-  (command.add #(not= (-?> core.active_view.imstate (. :focus)) nil) commands)
-  (keymap.add keymaps))
-
-(register-keys [:backspace :delete :left :right :shift+left :shift+right :home :end :shift+home :shift+end
-                :ctrl+left :ctrl+right :ctrl+shift+left :ctrl+shift+right :ctrl+c :ctrl+v])
-
-(fn cmd-predicate [p]
-  (var p-fn p)
-  (when (= (type p-fn) :string) (set p-fn (require p-fn)))
-  (when (= (type p-fn) :table)
-    (local cls p-fn)
-    (set p-fn (fn [] (core.active_view:is cls))))
-  (fn [] (when (= (-?> core.active_view.imstate (. :focus)) nil)
-           (p-fn))))
-
-(fn make-tag [tag]
-  (match (type tag)
-    :string tag
-    :table  (table.concat tag "::")
-    _       (tostring tag)))
-
-(fn mouse-inside [x y w h]
-  (local (mx my) (values (love.mouse.getX) (love.mouse.getY)))
-  (and (>= mx x) (<= mx (+ x w)) (>= my y) (<= my (+ y h))))
-
-(fn activate [view tag x y w h]
-  (when (and (= view.imstate.left :pressed) (mouse-inside x y w h))
-    (set view.imstate.active (make-tag tag))
-    true))
-(fn active? [view tag] (= view.imstate.active (make-tag tag)))
-(fn button [view tag x y w h]
-  (when (mouse-inside x y w h) (set view.cursor :hand))
-  (activate view tag x y w h)
-  (and (active? view tag) (= view.imstate.left :released) (mouse-inside x y w h)))
-
-(fn textbutton [view label x y]
-  (local (w h) (values (+ (style.font:get_width label) 8) 24))
-  (renderer.draw_rect x y w h style.selection)
-  (renderer.draw_text style.font label (+ x 4) (+ y 4) style.text)
-  (values (button view label x y w h) (+ y h)))
-
-(fn checkbox [view name isset x y ?tag]
-  (love.graphics.rectangle (if isset :fill :line) x y 12 12)
-  (local xEnd (renderer.draw_text style.font name (+ x 16) y style.text))
-  (love.graphics.setColor 1 1 1 1)
-  (button view (or ?tag name) x y (- xEnd x) 12))
-
-(fn focused? [view tag] (= tag (-?> view.imstate.focus (. :tag))))
-(fn focus [view tag x y w h opts]
-  (if (activate view tag x y w h)
-      (set view.imstate.focus
-        (doto (lume.clone (or opts {}))
-          (tset :tag tag)))
-
-      (and (= view.imstate.left :released) (focused? view tag) (not (active? view tag)))
-      (set view.imstate.focus nil))
-  (focused? view tag))
-
-(local blink_period 0.8)
-(fn x-from-i [s i xLeft font]
-  (if (or (<= i 1) (= s "")) xLeft
-      (x-from-i (s:sub 2) (- i 1) (+ xLeft (font:get_width (s:sub 1 1))) font)))
-(fn i-from-x [s x xLeft font ?i]
-  (local i (or ?i 1))
-  (local w (font:get_width (s:sub 1 1)))
-  (local xMid (+ xLeft (/ w 2)))
-  (if (or (<= x xMid) (= s "")) i
-      (i-from-x (s:sub 2) x (+ xLeft w) font (+ i 1))))
-
-(fn next-match [text i di pred]
-  (local imax (+ (length text) 1))
-  (local inext (+ i di))
-  (if (<= inext 1) 1
-      (> inext imax) imax
-      (pred (text:sub inext inext)) (if (< di 0) i inext)
-    (next-match text inext di pred)))
-(fn is-nonword-char [char] (config.non_word_chars:find char nil true))
-(fn next-word [text i di]
-  (let [iwordboundary (next-match text i di #(is-nonword-char $1))]
-    (next-match text iwordboundary di #(not (is-nonword-char $1)))))
-
-(fn textnav [key i text]
-  (local imax (+ (length text) 1))
-  (match key
-    :left       (math.max 1 (- i 1))
-    :right      (math.min imax (+ i 1))
-    :ctrl+left  (next-word text i -1)
-    :ctrl+right (next-word text i 1)
-    :home       1
-    :end        imax))
-
-(fn selection-span [view]
-  (let [f       view.imstate.focus
-        iStart  (math.min f.i f.iAnchor)
-        iLim    (math.max f.i f.iAnchor)]
-    (values iStart iLim)))
-(fn selection-text [view text]
-  (local (iStart iLim) (selection-span view))
-  (text:sub iStart (- iLim 1)))
-
-(fn replace-selection [view s replacement ?iStart ?iLim]
-  (local (iStart iLim) (if ?iLim (values ?iStart ?iLim) (selection-span view)))
-  (local text
-    (.. (s:sub 1 (- iStart 1))
-        replacement
-        (s:sub iLim)))
-  (local iNew (+ iStart (length replacement)))
-  (set view.imstate.focus.i iNew)
-  (set view.imstate.focus.iAnchor iNew)
-  text)
-
-(fn textbox [view tag text x y w]
-  (var textNew (or text ""))
-  (local (h hText xText yText) (values (+ (style.font:get_height) 4) (style.font:get_height) (+ x 2) (+ y 2)))
-
-  ; handle key events
-  (when (focus view tag x y w h {:i 1 :iAnchor 1 :blink (love.timer.getTime)})
-    (local f view.imstate.focus)
-    (when (> f.i (+ (length text) 1))       (set f.i (+ (length text) 1)))
-    (when (> f.iAnchor (+ (length text) 1)) (set f.iAnchor (+ (length text) 1)))
-    (when view.imstate.text
-      (set textNew (replace-selection view textNew view.imstate.text)))
-    (each [_ key (ipairs (or view.imstate.keys []))]
-      (set view.imstate.focus.blink (love.timer.getTime))
-      (if (= key :ctrl+c) (system.set_clipboard (selection-text view textNew))
-          (= key :ctrl+v) (set textNew (replace-selection view textNew (system.get_clipboard)))
-          (key:find "shift%+") (set f.i (or (textnav (key:gsub "shift%+" "") f.i textNew) f.i))
-        (let [iNav (textnav key f.i textNew)]
-          (when iNav
-            (set f.i iNav)
-            (set f.iAnchor iNav))
-          (when (or (= key :delete) (= key :backspace))
-            (local (iStartDel iLimDel)
-              (if (not= f.i f.iAnchor) (selection-span view)
-                  (= key :delete)      (values f.i (+ f.i 1))
-                  (= key :backspace)   (values (math.max 1 (- f.i 1)) f.i)))
-            (set textNew (replace-selection view textNew "" iStartDel iLimDel)))))))
-
-  ; handle mouse events
-  (when (mouse-inside x y w h) (set view.cursor :ibeam))
-  (when (and (focused? view tag) (active? view tag) (mouse-inside x y w h))
-    (local mouse-i (i-from-x textNew (love.mouse.getX) x style.font))
-    (when (= view.imstate.left :pressed)
-      (set view.imstate.focus.iAnchor mouse-i))
-    (set view.imstate.focus.i mouse-i))
-
-  ; draw box
-  (love.graphics.setLineWidth 1)
-  (love.graphics.rectangle :line x y w h)
-  (if (focused? view tag)
-    ; draw text with selection + caret
-    (let [(iStart iLim) (selection-span view)
-          xSelect (renderer.draw_text style.font (textNew:sub 1 (- iStart 1)) xText yText style.text)
-          sSelect (textNew:sub iStart (- iLim 1))
-          wSelect (style.font:get_width sSelect)
-          xTail   (+ xSelect wSelect)]
-      (when (> wSelect 0)
-        (renderer.draw_rect xSelect yText wSelect hText style.selection)
-        (renderer.draw_text style.font sSelect xSelect yText style.text))
-      (renderer.draw_text style.font (textNew:sub iLim) xTail yText style.text)
-      (when (or (active? view tag)
-                 (< (% (- (love.timer.getTime) view.imstate.focus.blink) (* blink_period 2)) blink_period))
-         (renderer.draw_rect (x-from-i textNew view.imstate.focus.i xText style.font) yText style.caret_width hText style.caret)))
-    ; just draw the text
-    (renderer.draw_text style.font textNew xText yText style.text))
-  (love.graphics.setColor 1 1 1)
-  (values textNew (+ y h)))
-
-(fn textfield [view label text x y wLabel wText]
-  (renderer.draw_text style.font label x y style.text)
-  (textbox view label text (+ x wLabel) y wText))
-
-{: attach-imstate : cmd-predicate : mouse-inside : activate : active? : button : checkbox : textbox : textfield : textbutton}

editor/repl.fnl

@@ -2,23 +2,22 @@
 (local fennel (require :lib.fennel))
 (local style (require :core.style))
 (local lume (require :lib.lume))
-(local {: textbutton} (util.require :editor.imstate))
+(local {: textbutton : under : group-wrapper} (util.require :editor.imgui))
 (local {: inspect} (util.require :inspector))
 (local repl (util.hot-table ...))
 
-(fn repl.inspector [{: vals : states} view x y]
+(fn repl.inspector [{: w &as form} {: vals : states}]
-  (var h 0)
+  (let [g (group-wrapper form)]
     (each [i v (ipairs vals)]
-    (set h (+ h (inspect (. states i) v view x (+ y h) view.size.x))))
+      (g #(inspect $...) (under (g) {: w}) (. states i) v))
-  (+ h style.padding.y))
+    (g)))
 
 (fn repl.notify [listeners line]
   (each [_ listener (ipairs listeners)]
     (listener:append line)))
 
 (fn repl.mk-result [vals]
-  (local inspector #(repl.inspector $...))
+  {:draw repl.inspector : vals :states (icollect [_ (ipairs vals)] {})})
-  {:draw inspector : vals :states (icollect [_ (ipairs vals)] {})})
 
 (fn repl.run [{: listeners}]
   (fennel.repl {:readChunk coroutine.yield

editor/replview.fnl

@@ -1,5 +1,5 @@
 (local util (require :lib.util))
-(local {: attach-imstate : textbox} (util.require :editor.imstate))
+(local {: attach-imstate : textbox : textbutton : label : under : reform : group-wrapper : mouse-inside} (util.require :editor.imgui))
 (local View (require :core.view))
 (local style (require :core.style))
 
@@ -13,6 +13,7 @@
   (set self.cmd "")
   (set self.scrollheight math.huge)
   (set self.scrollable true)
+  (set self.title "REPL")
   (self.conn:listen self))
 
 (fn ReplView.try_close [self do_close]
@@ -24,38 +25,36 @@
 (fn ReplView.append [self line]
   (table.insert self.log line))
 
-(fn ReplView.draw-cmd [{: cmd} view x y]
+(fn ReplView.draw-cmd [{: x : y : w : view &as form} {: cmd} iline]
-  (renderer.draw_text style.font cmd x y style.text)
+  (label form cmd)
-  (+ (style.font:get_height) style.padding.y))
+  (when (mouse-inside x y w form.h)
+    (when (textbutton (reform form {:x (+ x w -35) :into {}}) :X)
+      (table.remove view.log iline)
+      (table.remove view.log iline))
+    (when (textbutton (reform form {:x (+ x w -60) :into {}}) :!)
+      (view:submit cmd))))
 
 (fn ReplView.submit [self ?cmd]
   (local cmd (or ?cmd self.cmd))
   (when (= ?cmd nil)
     (set self.cmd ""))
-  (self:append {:draw #(self.draw-cmd $...) : cmd})
+  (self:append {:draw self.draw-cmd : cmd})
   (self.conn:submit cmd))
 
 (fn ReplView.draw [self]
   (self:draw_background style.background)
   (self:draw_scrollbar)
-  (var x (- self.position.x self.scroll.x))
+  (let [{: w &as form} (self:form)
-  (var y (- self.position.y self.scroll.y))
+        g (group-wrapper form)]
-  (var rendered-h 0)
-
     ; todo: cache sizes and avoid drawing if offscreen?
     ; note: then offscreen items can't be focussed without further effort
     ; todo: draw line numbers
     (each [i line (ipairs self.log)]
-    (let [h (line:draw self x y)]
+      (g line.draw (under (g) {: w}) line i))
-      (set y (+ y h))
+    (set self.cmd (g textbox (under (g) {: w :tag :command}) self.cmd))
-      (set rendered-h (+ rendered-h h))))
+    (self:end-scroll (g))))
 
-  (set self.cmd (textbox self :command self.cmd x y self.size.x))
+(fn ReplView.get_name [self] self.title)
-
-  (local pin-to-bottom (>= self.scroll.to.y (- self.scrollheight self.size.y)))
-  (set self.scrollheight (+ rendered-h (style.font:get_height) 4))
-  (when pin-to-bottom
-    (set self.scroll.to.y (- self.scrollheight self.size.y))))
 
 ReplView
 

inspector/debug.fnl

@@ -0,0 +1,30 @@
+(local core (require :core))
+(local style (require :core.style))
+(local util (require :lib.util))
+(local repl (require :editor.repl))
+(local ReplView (require :editor.replview))
+
+(local module (util.hot-table ...))
+
+(fn find-existing-inspector-window [name]
+  (var result nil)
+  (each [_ view (ipairs (core.root_view.root_node:get_children)) :until result]
+    (when (= view.inspector-name name)
+      (set result view)))
+  result)
+
+(fn create-inspector-window [name ?value]
+  (let [node (core.root_view:get_active_node)
+        conn (repl.new)
+        view (ReplView conn)]
+    (set view.inspector-name name)
+    (set view.title name)
+    (view:append {:draw (fn [_ _ x y] (renderer.draw_text style.font name x y style.text) (+ (style.font:get_height) style.padding.y))})
+    (view:append (repl.mk-result [?value]))
+    (node:add_view view)))
+
+(lambda module.show [name ?value]
+  (when (= (find-existing-inspector-window name) nil)
+    (create-inspector-window name ?value)))
+
+module.hot

inspector/init.fnl

@@ -1,7 +1,7 @@
 (local util (require :lib.util))
 (local style (require :core.style))
 (local {: defmulti : defmethod} (util.require :lib.multimethod))
-(local {: textbutton} (util.require :editor.imstate))
+(local {: textbutton : label : under : right-of : reform : group-wrapper  } (util.require :editor.imgui))
 
 (local inspector (util.hot-table ...))
 
@@ -15,7 +15,7 @@
   best-inspector)
 
 (set inspector.inspect
-  (defmulti (fn [state value view x y w]
+  (defmulti (fn [form state value]
               (when (= state.inspector nil)
                 (set state.inspector (inspector.best-inspector value)))
               state.inspector) :inspect ...))
@@ -26,43 +26,29 @@
   (tset inspector.inspectors name {: predicate : priority :inspector inspect-func})
   (defmethod inspector.inspect name inspect-func))
 
-(fn inspector.text-height [text ?font]
+(inspector.register :default 0 #true (fn [form state value]
-  (let [font (or ?font style.code_font)
+  (label (reform form {:font style.code_font}) (fv value))))
-        (_ newlines) (text:gsub "\n" "\n")]
-    (* (font:get_height) (+ newlines 1))))
-
-(fn inspector.draw-text [font text x y color]
-  (renderer.draw_text font text x y color)
-  (inspector.text-height text))
-
-(inspector.register :default 0 #true (fn [state value view x y w]
-  (inspector.draw-text style.code_font (fv value) x y style.text)))
 
 (inspector.register :table 10
   #(and (= (type $1) :table) (not= (next $1) nil))
-  (fn [state tbl view x y w]
+  (fn [form state tbl]
-    (local font style.code_font)
+    (let [get-kstate (fn [tbl k state]
-    (var h 0)
-    ; todo: state assumes an .inspector key
-    ; todo: inspector swapping
-    ; todo: edit in place?
-    (fn get-kstate [tbl k state]
             (when (= nil state.keys) (set state.keys {}))
             (when (= nil (?. state.keys k))
               (util.nested-tset state [:keys k] {:collapsed (= (type (. tbl k)) :table) :children {}}))
             (. state.keys k))
+          g (group-wrapper form)]
       (each [k v (pairs tbl)]
-      (let [kstate (get-kstate tbl k state)
+        (let [kstate (get-kstate tbl k state)]
-            kstr (fv k)
+          ; todo: state assumes an .inspector key
-            wk (font:get_width kstr)
+          ; todo: inspector swapping
-            xoffset (+ wk style.padding.x)
+          ; todo: edit in place?
-            toggle-collapse (textbutton view kstr x (+ y h))
+          (when (g textbutton (under form {:font style.code_font}) (fv k))
-            hv (if kstate.collapsed
+            (set kstate.collapsed (not kstate.collapsed)))
-                 (inspector.draw-text font "..." (+ x xoffset) (+ y h) style.syntax.comment)
+          (if kstate.collapsed
-                 (inspector.inspect kstate.children v view (+ x xoffset) (+ y h) (- w xoffset)))]
+             (g label (right-of form {:color style.syntax.comment :into {}}) "...")
-        (when toggle-collapse (set kstate.collapsed (not kstate.collapsed)))
+             (g #(inspector.inspect $...) (right-of form {:into {}}) kstate.children v))
-        (set h (+ h hv style.padding.y))))
+          (g))))))
-    h))
 
 inspector.hot
 

lib/util.fnl

@@ -9,12 +9,17 @@
 
 (fn lo [v] (bit.band v 0xff))
 (fn hi [v] (bit.band (bit.rshift v 8) 0xff))
+(fn loword [v] (bit.band v 0xffff))
+(fn hiword [v] (bit.band (bit.rshift v 16) 0xffff))
+
 (fn int8-to-bytes [i]
   (string.char (lo i)))
 (fn int16-to-bytes [i]
   (string.char (lo i) (hi i)))
 (fn int24-to-bytes [i]
-  (string.char (lo i) (hi i) (bit.band (bit.rshift i 16) 0xff)))
+  (string.char (lo i) (hi i) (lo (bit.rshift i 16))))
+(fn int32-to-bytes [i]
+  (string.char (lo i) (hi i) (lo (bit.rshift i 16)) (hi (bit.rshift i 16))))
 (fn bytes-to-uint8 [b ?offset]
   (string.byte b (+ 1 (or ?offset 0)) (+ 1 (or ?offset 0))))
 (fn bytes-to-uint16 [b ?offset]
@@ -23,6 +28,9 @@
 (fn bytes-to-uint24 [b ?offset]
   (local (lo mid hi) (string.byte b (+ 1 (or ?offset 0)) (+ 3 (or ?offset 0))))
   (bit.bor lo (bit.lshift mid 8) (bit.lshift hi 16)))
+(fn bytes-to-uint32 [b ?offset]
+  (local [lo hi] [(bytes-to-uint16 b ?offset) (bytes-to-uint16 b (+ 2 (or ?offset 0)))])
+  (bit.bor lo (bit.lshift hi 16)))
 
 (fn splice [bytes offset str]
   (.. (bytes:sub 1 offset)
@@ -106,8 +114,29 @@
             (tset t next-key {}))
           (nested-tset (. t next-key) (lume.slice keys 2) value)))))
 
-{: int8-to-bytes : int16-to-bytes : int24-to-bytes : bytes-to-uint8 : bytes-to-uint16 : bytes-to-uint24
+(fn file-exists [name]
- : splice : lo : hi
+  (let [f (io.open name :r)]
- : reload : hotswap : swappable :require swappable-require : hot-table : nested-tset
+    (when (not= f nil) (io.close f))
- : readjson : writejson : waitfor : in-coro : multival}
+    (not= f nil)))
+
+(fn pairoff [l]
+  (fn [_ iprev] (let [i (if iprev (+ iprev 2) 1)]
+                          (when (< i (length l)) (values i (. l i) (. l (+ i 1)))))))
+
+(fn countiter [minmax ?max ?step]
+  (let [min (if ?max minmax 1)
+        max (or ?max minmax)
+        step (or ?step 1)]
+    (fn [_ iprev]
+      (let [i (if iprev (+ iprev step) min)]
+        (when (if (> step 0) (<= i max) (>= i max)) i)))))
+
+(fn condlist [...] (let [l []] (lume.push l ...) l))
+
+(fn prototype [base] (setmetatable {} {:__index base}))
+
+{: int8-to-bytes : int16-to-bytes : int24-to-bytes : int32-to-bytes : bytes-to-uint8 : bytes-to-uint16 : bytes-to-uint24 : bytes-to-uint32
+ : splice : lo : hi : loword : hiword : condlist : prototype
+ : reload : hotswap : swappable :require swappable-require : hot-table : nested-tset : pairoff : countiter
+ : readjson : writejson : file-exists : waitfor : in-coro : multival}