Bring in upgrades from bomberpac (repl, fennel 0.9.1), more objects

editor/imstate.fnl

@@ -155,11 +155,13 @@
 
 (fn textbox [view tag text x y w]
   (var textNew (or text ""))
-  (local (h hText xText yText) (values 20 16 (+ x 2) (+ y 2)))
+  (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 []))]

editor/init.fnl

@@ -57,6 +57,22 @@
   "ctrl+v"    "tileedit:paste"
 })
 
+(command.add :editor.replview {
+  "repl:submit" #(core.active_view:submit)
+})
+
+(local ReplView (require :editor.replview))
+(local repl (require :editor.repl))
+(command.add nil {
+  "repl:create" (fn []
+    (local node (core.root_view:get_active_node))
+    (node:add_view (ReplView (repl.new)))
+  )
+})
+(keymap.add {
+  :return "repl:submit"
+})
+
 (fn inline-eval [eval]
   (let [ldoc core.active_view.doc
         (aline acol bline bcol) (ldoc:get_selection)

editor/repl.fnl

@@ -0,0 +1,49 @@
+(local util (require :lib.util))
+(local fennel (require :lib.fennel))
+(local style (require :core.style))
+(local lume (require :lib.lume))
+(local {: textbutton} (util.require :editor.imstate))
+(local {: inspect} (util.require :inspector))
+(local repl (util.hot-table ...))
+
+(fn repl.inspector [{: vals : states} view x y]
+  (var h 0)
+  (each [i v (ipairs vals)]
+    (set h (+ h (inspect (. states i) v view x (+ y h) view.size.x))))
+  (+ h style.padding.y))
+
+(fn repl.notify [listeners line]
+  (each [_ listener (ipairs listeners)]
+    (listener:append line)))
+
+(fn repl.mk-result [vals]
+  (local inspector #(repl.inspector $...))
+  {:draw inspector : vals :states (icollect [_ (ipairs vals)] {})})
+
+(fn repl.run [{: listeners}]
+  (fennel.repl {:readChunk coroutine.yield
+                :onValues #(repl.notify listeners (repl.mk-result $1))
+                :onError (fn [errType err luaSource] (repl.notify listeners (repl.mk-result [err])))
+                :pp #$1
+                :env (lume.clone _G)}))
+
+(fn repl.listen [{: listeners} listener]
+  (table.insert listeners listener))
+
+(fn repl.unlisten [{: listeners} listener]
+  (lume.remove listeners listener))
+
+(fn repl.submit [{: coro} chunk]
+  (coroutine.resume coro (.. chunk "\n")))
+
+(fn repl.new []
+  (local result
+    {:listeners []
+     :listen #(repl.listen $...)
+     :unlisten #(repl.unlisten $...)
+     :submit #(repl.submit $...)
+     :coro (coroutine.create repl.run)})
+  (coroutine.resume result.coro result)
+  result)
+
+repl.hot

editor/replview.fnl

@@ -0,0 +1,61 @@
+(local util (require :lib.util))
+(local {: attach-imstate : textbox} (util.require :editor.imstate))
+(local View (require :core.view))
+(local style (require :core.style))
+
+(local ReplView (View:extend))
+
+(fn ReplView.new [self conn]
+  (ReplView.super.new self)
+  (attach-imstate self)
+  (set self.conn conn)
+  (set self.log [])
+  (set self.cmd "")
+  (set self.scrollheight math.huge)
+  (set self.scrollable true)
+  (self.conn:listen self))
+
+(fn ReplView.try_close [self do_close]
+  (self.conn:unlisten self)
+  (ReplView.super.try_close self do_close))
+
+(fn ReplView.get_scrollable_size [self] self.scrollheight)
+
+(fn ReplView.append [self line]
+  (table.insert self.log line))
+
+(fn ReplView.draw-cmd [{: cmd} view x y]
+  (renderer.draw_text style.font cmd x y style.text)
+  (+ (style.font:get_height) style.padding.y))
+
+(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.conn:submit cmd))
+
+(fn ReplView.draw [self]
+  (self:draw_background style.background)
+  (self:draw_scrollbar)
+  (var x (- self.position.x self.scroll.x))
+  (var y (- self.position.y self.scroll.y))
+  (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)]
+      (set y (+ y h))
+      (set rendered-h (+ rendered-h h))))
+
+  (set self.cmd (textbox self :command self.cmd x y self.size.x))
+
+  (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
+

game/tiles.json

@@ -1 +1 @@
-[{"gfx":"8080808080808080808080808080808080808080808080808080808080808080","word":"","label":"","flags":{"walkable":true}},{"gfx":"8080C0C0C0C0E0F0F8FCE6E6E0B0B0B0808183838383878F9FBFE7E7868C8C8C","word":"","label":"player-frame1","flags":[]},{"gfx":"8080808084CCFCFCFCFCFCF8F0B0B0B080808080E1E1E1F1B99F9F8F8F8C8C8C","word":"","label":"","flags":[]},{"gfx":"D5D5D5858585A5A5A5A5858585D5D5D5AAAAAAA8A8A8A9A9A9A9A8A8A8AAAAAA","word":"","label":"","flags":[]},{"gfx":"8080D4D0D0D0D4D45454D4D4D4D0808080808A8282828A8A8A0A0A8A8A828080","word":"pot","label":"","flags":[]},{"gfx":"8080808080D490948484A48494D080808080808080AA88A8A0A5A5A0A88A8080","word":"","label":"","flags":[]},{"gfx":"8080D4D0D0D0D4D45454D4D4D4D0808080808A8282828A8A8A0A0A8A8A828080","word":"","label":"","flags":[]},{"gfx":"000000A0908884827E0A0A0A0000000000000000201008040785858500000000","word":"","label":"","flags":[]},{"gfx":"000014040414500000000000A888A8800000282020280A010101010195919580","word":"","label":"","flags":[]},{"gfx":"00008C92921C60105010781C0E070300000098A4A41C030504050F1C38706000","word":"","label":"","flags":[]}]
+[{"gfx":"8080808080808080808080808080808080808080808080808080808080808080","word":"","label":"","flags":{"walkable":true}},{"gfx":"8080C0C0C0C0E0F0F8FCE6E6E0B0B0B0808183838383878F9FBFE7E7868C8C8C","word":"","label":"player-frame1","flags":[]},{"gfx":"8080808084CCFCFCFCFCFCF8F0B0B0B080808080E1E1E1F1B99F9F8F8F8C8C8C","word":"","label":"","flags":[]},{"gfx":"D5D5D5858585A5A5A5A5858585D5D5D5AAAAAAA8A8A8A9A9A9A9A8A8A8AAAAAA","word":"","label":"","flags":[]},{"gfx":"8080D4D0D0D0D4D45454D4D4D4D0808080808A8282828A8A8A0A0A8A8A828080","word":"pot","label":"","flags":[]},{"gfx":"8080808080D490948484A48494D080808080808080AA88A8A0A5A5A0A88A8080","word":"","label":"","flags":[]},{"gfx":"8080D4D0D0D0D4D45454D4D4D4D0808080808A8282828A8A8A0A0A8A8A828080","word":"","label":"","flags":[]},{"gfx":"000000A0908884827E0A0A0A0000000000000000201008040785858500000000","word":"","label":"","flags":[]},{"gfx":"000014040414500000000000A888A8800000282020280A010101010195919580","word":"","label":"","flags":[]},{"gfx":"00008C92921C60105010781C0E070300000098A4A41C030504050F1C38706000","word":"","label":"","flags":[]},{"gfx":"000000004040000000D4D4ECECECD480000000000202010101AAAAB6B6B6AA80","word":"","label":"","flags":[]},{"gfx":"0000000000004828282828482800000000000000000004050505050405000000","word":"","label":"","flags":[]}]

inspector/init.fnl

@@ -0,0 +1,68 @@
+(local util (require :lib.util))
+(local style (require :core.style))
+(local {: defmulti : defmethod} (util.require :lib.multimethod))
+(local {: textbutton} (util.require :editor.imstate))
+
+(local inspector (util.hot-table ...))
+
+(fn inspector.best-inspector [v]
+  (var best-inspector nil)
+  (var best-priority -1)
+  (each [inspector {: priority : predicate} (pairs inspector.inspectors)]
+    (when (and (> priority best-priority) (predicate v))
+      (set best-inspector inspector)
+      (set best-priority priority)))
+  best-inspector)
+
+(set inspector.inspect
+  (defmulti (fn [state value view x y w]
+              (when (= state.inspector nil)
+                (set state.inspector (inspector.best-inspector value)))
+              state.inspector) :inspect ...))
+
+(fn inspector.register [name priority predicate inspect-func]
+  (when (= inspector.inspectors nil)
+    (set inspector.inspectors {}))
+  (tset inspector.inspectors name {: predicate : priority :inspector inspect-func})
+  (defmethod inspector.inspect name inspect-func))
+
+(fn inspector.text-height [text ?font]
+  (let [font (or ?font style.code_font)
+        (_ 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]
+    (local font style.code_font)
+    (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))
+    (each [k v (pairs tbl)]
+      (let [kstate (get-kstate tbl k state)
+            kstr (fv k)
+            wk (font:get_width kstr)
+            xoffset (+ wk style.padding.x)
+            toggle-collapse (textbutton view kstr x (+ y h))
+            hv (if kstate.collapsed
+                 (inspector.draw-text font "..." (+ x xoffset) (+ y h) style.syntax.comment)
+                 (inspector.inspect kstate.children v view (+ x xoffset) (+ y h) (- w xoffset)))]
+        (when toggle-collapse (set kstate.collapsed (not kstate.collapsed)))
+        (set h (+ h hv style.padding.y))))
+    h))
+
+inspector.hot
+

lib/multimethod.fnl

@@ -0,0 +1,18 @@
+(local util (require :lib.util))
+
+(local mm {})
+
+(fn mm.__call [{: module : name} ...]
+  (let [dispatcher (. mm.dispatchers module name)
+        key (dispatcher ...)
+        method (or (. mm.methods module name key) (. mm.methods module name :default))]
+    (method ...)))
+
+(fn mm.defmulti [dispatcher name module]
+  (util.nested-tset mm [:dispatchers module name] dispatcher)
+  (setmetatable {: module : name} mm))
+
+(fn mm.defmethod [{: module : name} key method]
+  (util.nested-tset mm [:methods module name key] method))
+
+mm

lib/util.fnl

@@ -53,6 +53,16 @@
 (fn swappable-require [modname]
   (swappable (require modname)))
 
+(fn hot-table [modname]
+  (local tbl {})
+  (fn find-table []
+    (let [loaded-pkg (. package.loaded modname)]
+      (if (= (type loaded-pkg) :table) loaded-pkg tbl)))
+  (setmetatable {:hot tbl} {
+    :__index (fn [_ key] (. (find-table) key))
+    :__newindex (fn [_ key val] (tset (find-table) key val))
+  }))
+
 (fn readjson [filename]
   (local f (io.open filename :r))
   (local text (f:read "*a"))
@@ -64,11 +74,6 @@
   (f:write (json.encode value))
   (f:close))
 
-(fn file-exists [name]
-  (let [f (io.open name :r)]
-    (when (not= f nil) (io.close f))
-    (not= f nil)))
-
 (fn waitfor [pred]
   (local coro (coroutine.running))
   (core.add_thread
@@ -81,8 +86,33 @@
 
 (fn in-coro [f ...] (-> (coroutine.create f) (coroutine.resume ...)))
 
+(fn multival-next [multival i]
+  (when (< i multival.n)
+    (values (+ i 1) (. multival (+ i 1)))))
+
+(fn multival-ipairs [multival]
+  (values multival-next multival 0))
+
+(fn multival [...]
+  (local multival {:n (select :# ...) :ipairs multival-ipairs})
+  (for [i 1 multival.n]
+    (tset multival i (select i ...)))
+  multival)
+
+(fn nested-tset [t keys value]
+  (let [next-key (. keys 1)]
+    (if (= (length keys) 1) (tset t next-key value)
+      (do (when (= (. t next-key) nil)
+            (tset t next-key {}))
+          (nested-tset (. t next-key) (lume.slice keys 2) value)))))
+
+(fn file-exists [name]
+  (let [f (io.open name :r)]
+    (when (not= f nil) (io.close f))
+    (not= f nil)))
+
 {: int8-to-bytes : int16-to-bytes : int24-to-bytes : bytes-to-uint8 : bytes-to-uint16 : bytes-to-uint24
  : splice : lo : hi
- : reload : hotswap : swappable :require swappable-require
+ : reload : hotswap : swappable :require swappable-require : hot-table : nested-tset
- : readjson : writejson : file-exists : waitfor : in-coro}
+ : readjson : writejson : file-exists : waitfor : in-coro : multival}