Arrow key support in Neut Tower

(todo: investigate luarocks)

editor/8bitsy.fnl

@@ -30,8 +30,8 @@
     (let [maps (icollect [imap _ (ipairs files.game.levels)] (.. :map imap))
           map (or action.map (. maps 1))
           y (+ y style.padding.y)
-          map (dropdown view [:warp :map i] map maps x y 100)
-          (position-string y) (textbox view [:warp :loc i] (string.format "%x" (or action.position 0)) (+ x 150) y 150)
+          map (dropdown view [:warp :map i] map maps x y (* 100 SCALE))
+          (position-string y) (textbox view [:warp :loc i] (string.format "%x" (or action.position 0)) (+ x (* 150 SCALE)) y (* 150 SCALE))
           position (or (tonumber position-string 16) action.position)]
       (set action.map map)
       (set action.position position)
@@ -47,13 +47,13 @@
     (let [y (+ y style.padding.y)
           x (renderer.draw_text style.font "Set " x y style.text)
           flag (or action.flag (. files.game.flags 1))
-          flag (dropdown view [:set-flag :flag i] flag files.game.flags x y 100)
-          x (renderer.draw_text style.font " to " (+ x 100) y style.text)
+          flag (dropdown view [:set-flag :flag i] flag files.game.flags x y (* 100 SCALE))
+          x (renderer.draw_text style.font " to " (+ x (* 100 SCALE)) y style.text)
           options (lume.concat
                     [{:label "<Yes>" :value 0xffff} {:label "<No>" :value 0}]
                     (icollect [_ flag (ipairs files.game.flags)] {:label flag :value (.. :cond- flag)}))
           rhs (or action.rhs (. options 1))
-          (rhs y) (dropdown view [:set-flag :rhs i] rhs options x y 100)]
+          (rhs y) (dropdown view [:set-flag :rhs i] rhs options x y (* 100 SCALE))]
       (set action.flag flag)
       (set action.rhs rhs)
       y))

editor/imstate.fnl

@@ -95,17 +95,18 @@
   (activate view tag x y w h)
   (values (and (active? view tag) (= view.imstate.left :released) (mouse-inside x y w h)) (+ y h style.padding.y)))
 
-(fn textbutton [view label x y]
-  (local (w h) (values (+ (style.font:get_width label) style.padding.x) (+ (style.font:get_height) style.padding.y)))
-  (renderer.draw_rect x y w h style.selection)
-  (renderer.draw_text style.font label (+ x (/ style.padding.x 2)) (+ y (/ style.padding.y 2)) style.text)
-  (values (button view label x y w h) (+ y h)))
+(fn textbutton [view label x y ?font]
+  (let [font (or ?font style.font)]
+    (local (w h) (values (+ (font:get_width label) style.padding.x) (+ (font:get_height) style.padding.y)))
+    (renderer.draw_rect x y w h style.selection)
+    (renderer.draw_text font label (+ x (/ style.padding.x 2)) (+ y (/ style.padding.y 2)) 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.rectangle (if isset :fill :line) x y (* 12 SCALE) (* 12 SCALE))
+  (local xEnd (renderer.draw_text style.font name (+ x (* 16 SCALE)) y style.text))
   (love.graphics.setColor 1 1 1 1)
-  (button view (or ?tag name) x y (- xEnd x) 12))
+  (button view (or ?tag name) x y (- xEnd x) (* 12 SCALE)))
 
 (fn focused? [view tag] (= (make-tag tag) (-?> view.imstate.focus (. :tag))))
 (fn focus [view tag x y w h opts]

editor/mapedit.fnl

@@ -66,7 +66,7 @@
         level-count (length files.game.levels)
         _ (do (for [i 1 level-count] (tset options i i))
               (table.insert options :New))
-        (ilevel yNext) (dropdown self :map-selector self.ilevel options (+ x 50) y 100)]
+        (ilevel yNext) (dropdown self :map-selector self.ilevel options (+ x (* 50 SCALE)) y (* 100 SCALE))]
     (when (not= ilevel self.ilevel)
       (set self.ilevel (if (= ilevel :New) (+ level-count 1) ilevel))
       (self:load-level))
@@ -170,13 +170,13 @@
   (var istep-to-delete nil)
   (when (not object.steps) (set object.steps []))
   (each [istep step (ipairs object.steps)]
-    (when (textbutton self "X" (+ x 280) y)
+    (when (textbutton self "X" (+ x (* 280 SCALE)) y)
       (set istep-to-delete istep))
     (set step.condition (. (dropdown self [:code-condition istep] (condition-label step.condition) (condition-options)
-                                     (+ x 100 style.padding.x) y 100)
+                                     (+ x (* 100 SCALE) style.padding.x) y (* 100 SCALE))
                            :flag))
-    (set (step.action y) (dropdown self [:code-action istep] (or step.action (. actions.actionlist 1)) actions.actionlist x y 100))
-    (set y (actions.edit step self x y 300 istep))
+    (set (step.action y) (dropdown self [:code-action istep] (or step.action (. actions.actionlist 1)) actions.actionlist x y (* 100 SCALE)))
+    (set y (actions.edit step self x y (* 300 SCALE) istep))
     (set y (+ y style.padding.y)))
   (when istep-to-delete (table.remove object.steps istep-to-delete))
   (let [(do-new y) (textbutton self "+ New Step" x (+ y style.padding.y))]
@@ -186,14 +186,15 @@
 (fn advanced? [object]
   (or object.advanced
       (and (= object.advanced nil)
-           object.func)))
+           (not= object.func "")
+           (not= object.func nil))))
 
 (fn MapEditView.draw-object-advanced-editor [self object x y]
-  (let [(func y) (textfield self "Word" object.func x y 100 200)
-        (name y) (textfield self "Name" object.name x (+ y style.padding.y) 100 200)
-        (linkword y) (textfield self "Link word" object.linkword x (+ y style.padding.y) 100 200)
+  (let [(func y) (textfield self "Word" object.func x y (* 100 SCALE) (* 200 SCALE))
+        (name y) (textfield self "Name" object.name x (+ y style.padding.y) (* 100 SCALE) (* 200 SCALE))
+        (linkword y) (textfield self "Link word" object.linkword x (+ y style.padding.y) (* 100 SCALE) (* 200 SCALE))
         (do-unlink y) (if object.link (textbutton self "Unlink" x (+ y style.padding.y)) (values false y))
-        (linkentity y) (if object.link (values object.linkentity y) (textfield self "Link entity" object.linkentity x (+ y style.padding.y) 100 200))]
+        (linkentity y) (if object.link (values object.linkentity y) (textfield self "Link entity" object.linkentity x (+ y style.padding.y) (* 100 SCALE) (* 200 SCALE)))]
     (lume.extend object {: func : name : linkword : linkentity})
     (when do-unlink (set object.link nil))
     y))
@@ -203,10 +204,10 @@
         y (if (advanced? object)
               (self:draw-object-advanced-editor object x y)
               (self:draw-object-code-editor object x y))
-        new-flag-name (textbox self :new-flag-name self.new-flag-name x (+ y style.padding.y) 200)
-        (mk-new-flag y) (textbutton self "+ New Flag" (+ x 200 style.padding.x) (+ y style.padding.y))
-        do-delete (textbutton self "Delete" x (+ y 40))
-        (do-advanced y) (textbutton self (if (advanced? object) "Simple" "Advanced") (+ x 150) (+ y 40))]
+        new-flag-name (textbox self :new-flag-name self.new-flag-name x (+ y style.padding.y) (* 200 SCALE))
+        (mk-new-flag y) (textbutton self "+ New Flag" (+ x (* 200 SCALE) style.padding.x) (+ y style.padding.y))
+        do-delete (textbutton self "Delete" x (+ y (* style.padding.y 2)))
+        (do-advanced y) (textbutton self (if (advanced? object) "Simple" "Advanced") (+ x (* 150 SCALE)) (+ y (* style.padding.y 2)))]
     (set self.new-flag-name new-flag-name)
     (when mk-new-flag
       (when (= files.game.flags nil)
@@ -236,14 +237,16 @@
   (self:draw_background style.background)
   (self:draw_scrollbar)
   (local ytop y)
+  (local editor-on-side (> self.size.x (+ (* tilew mapw) (* 300 SCALE))))
   (set y (+ y (self:draw-map-selector x y) style.padding.y))
   (self:draw-map-editor x y)
   (set y (+ y (* tileh maph) style.padding.y))
-  (set y (+ y (self:draw-tile-selector x y (- self.size.x (* style.padding.x 2)))))
+  (set y (+ y (self:draw-tile-selector x y (if editor-on-side (* tilew mapw)
+                                             (- self.size.x (* style.padding.x 2))))))
 
-  (set (self.level.tickword y) (textfield self "Tick word" self.level.tickword x (+ y style.padding.y) 100 200))
-  (set (self.level.moveword y) (textfield self "Move word" self.level.moveword x (+ y style.padding.y) 100 200))
-  (set (self.level.loadword y) (textfield self "Load word" self.level.loadword x (+ y style.padding.y) 100 200))
+  (set (self.level.tickword y) (textfield self "Tick word" self.level.tickword x (+ y style.padding.y) (* 100 SCALE) (* 200 SCALE)))
+  (set (self.level.moveword y) (textfield self "Move word" self.level.moveword x (+ y style.padding.y) (* 100 SCALE) (* 200 SCALE)))
+  (set (self.level.loadword y) (textfield self "Load word" self.level.loadword x (+ y style.padding.y) (* 100 SCALE) (* 200 SCALE)))
   (let [(checked y-new) (checkbox self "Edit objects" (= self.itile nil) x (+ y style.padding.y))
         _ (when checked
             (set self.itile nil)
@@ -260,11 +263,11 @@
       (when checked (tset self.level levelflag (not (. self.level levelflag))))
       (set y y-new)))
   (when self.iobject
-    (set y (math.max y (if (> self.size.x (+ (* tilew mapw) 300))
+    (set y (math.max y (if editor-on-side
                          (self:draw-object-editor (+ x (* tilew mapw) style.padding.x) ytop)
                          (self:draw-object-editor x (+ y style.padding.y))))))
 
-  (set self.scrollheight (- y (+ self.position.y style.padding.y (- self.scroll.y)))))
+  (set self.scrollheight (+ y (- self.position.y) self.scroll.y style.padding.y)))
 
 (fn MapEditView.get_name [self] (.. "Map " self.ilevel))
 

editor/screenedit.fnl

@@ -88,8 +88,7 @@
   (self:draw-screen-editor (+ self.position.x 10) (+ self.position.y 10))
   (self:draw-tile-selector (+ self.position.x 10) (+ self.position.y 20 (* screenh screen-scale)) (- self.size.x 20)))
 
-(fn ScreenEditView.filename [self] "editor/brushes.json")
-(fn ScreenEditView.spritegen [self] char-to-sprite)
+(fn ScreenEditView.resource-key [self] "brushes")
 (fn ScreenEditView.tilesize [self] (values 8 8))
 (fn ScreenEditView.get_name [self] (.. "Screen: " self.screenfilename))
 

editor/tileedit.fnl

@@ -74,16 +74,18 @@
 (fn TileView.draw-tile-flag [self flagname x y]
   (local flags (-?> self.tilecache.tiles (. self.itile) (. :flags)))
   (local flagset (if flags (. flags flagname) false))
-  (when (checkbox self flagname flagset x y)
-    (tset flags flagname (if flagset nil true))))
+  (let [(checked yNew) (checkbox self flagname flagset x y)]
+    (when checked (tset flags flagname (if flagset nil true)))
+    yNew))
 
 (fn TileView.draw-tile-flags [self x y]
   (local tile (-?> self.tilecache.tiles (. self.itile)))
+  (var y y)
   (when tile
-    (set tile.word (textfield self "Default word" tile.word x y 100 200))
-    (set tile.label (textfield self "Label" tile.label x (+ y pixel-size 4) 100 200)))
+    (set (tile.word y) (textfield self "Default word" tile.word x (+ y style.padding.y) (* 100 SCALE) (* 200 SCALE)))
+    (set (tile.label y) (textfield self "Label" tile.label x (+ y style.padding.y) (* 100 SCALE) (* 200 SCALE))))
   (each [iflag flagname (ipairs (tiles.flags))]
-    (self:draw-tile-flag flagname x (+ y (* (+ iflag 1) (+ pixel-size 4))))))
+    (set y (self:draw-tile-flag flagname x (+ y style.padding.y)))))
 
 (fn TileView.update-tile [self newtile]
   (self.tilecache:update-tile self.itile newtile self.tilekey))

game/files.fnl

@@ -29,13 +29,13 @@
 
 (fn deserialize [key value root]
   (match key
-    (where (or :tiles :portraits :font)) (tile-deserialize value root)
+    (where (or :tiles :portraits :font :brushes)) (tile-deserialize value root)
     :levels (do (set value.map (value.map:fromhex)) value)
     _ value))
 
 (fn serialize [key value root]
   (match key
-    (where (or :tiles :portraits :font)) (tile-serialize value root)
+    (where (or :tiles :portraits :font :brushes)) (tile-serialize value root)
     :levels (do (set value.map (value.map:tohex)) value)
     _ value))
 
@@ -66,6 +66,7 @@
 (fn new-cache [game key]
   (let [spritegen (match key
                          :font tiledraw.char-to-sprite
+                         :brushes tiledraw.char-to-sprite
                          :portraits tiledraw.portrait-to-sprite
                          _ tiledraw.tile-to-sprite)
         gfx (. game key)]

neuttower/defs.fnl

@@ -143,7 +143,7 @@
     [:jmp (if (= (or map.moveword "") "") :move-noop map.moveword)]
     [:jmp (if (= (or map.loadword "") "") :next map.loadword)]))
 
-(vm.code:append :map-ptr [:db 0] :map-page [:db 0])
+(vm.code:append :map-ptr [:db 0] [:hot-preserve :map-page [:db 0]])
 (vm:word :map :lit :map-ptr :get)
 (vm:word :entity-count :map 240 :+ :bget)
 (vm:word :map-jaye-yx :map 241 :+ :get)

neuttower/init.fnl

@@ -52,7 +52,7 @@
   [:vm :hires
     :lit :level1 :load-level
     (vm:forever
-      (vm:hotswap-sync :lit :level6 :load-level)
+      (vm:hotswap-sync :full-redraw)
       :interactive-eval-checkpoint
       :handle-key
     )

neuttower/player.fnl

@@ -3,12 +3,15 @@
 
 (local {: walkable : neutable : debris : sittable} (tile.flag-to-bit))
 
+(vm:word :either= ; target val1 val2 -- f
+  :>rot :over := :>rot := :|)
+
 (vm:word :movement-dir ; key -- dyx
-  (vm:case [(string.byte "I") 0xff00]
-           [(string.byte "J") 0x00ff]
-           [(string.byte "K") 0x0001]
-           [(string.byte "M") 0x0100]
-           [:else             0x0000]))
+  (vm:ifchain [:dup (string.byte "I") 0x0b :either=] [:drop 0xff00]
+              [:dup (string.byte "J") 0x08 :either=] [:drop 0x00ff]
+              [:dup (string.byte "K") 0x15 :either=] [:drop 0x0001]
+              [:dup (string.byte "M") 0x0a :either=] [:drop 0x0100]
+                                                     [:drop 0x0000]))
 
 (vm:def :yx+ ; yx yx -- yx
   [:lda vm.TOP :x]

presentation/commands.fnl

@@ -2,11 +2,14 @@
 (local core (require :core))
 (local command (require :core.command))
 (local keymap (require :core.keymap))
+(local style (require :core.style))
 (local SlideshowView (require :presentation.engine))
 
 (fn set-scale [multiplier]
   (set _G.SCALE (* (love.graphics.getDPIScale) multiplier))
-  (util.hotswap :core.style))
+  (util.hotswap :core.style)
+  (when (= multiplier 1)
+    (set style.code_font (renderer.font.load (.. EXEDIR "/data/fonts/monospace.ttf") 15))))
 
 (command.add nil {
   "presentation:start" (fn []
@@ -21,11 +24,14 @@
   "presentation:prev" #(core.active_view:back)
   "presentation:next-slide" #(core.active_view:next-slide)
   "presentation:prev-slide" #(core.active_view:prev-slide)
+  "presentation:toggle-timer" #(core.active_view:toggle-timer)
+  "presentation:reset-timer" #(core.active_view:reset-timer)
 })
 (keymap.add {
   "left"        "presentation:prev"
   "right"       "presentation:next"
   "ctrl+left"   "presentation:prev-slide"
   "ctrl+right"  "presentation:next-slide"
+  "alt+t"       "presentation:toggle-timer"
 })
 

presentation/engine.fnl

@@ -2,6 +2,7 @@
 (local style (require :core.style))
 (local common (require :core.common))
 (local View (require :core.view))
+(local {: attach-imstate : textbutton} (require :editor.imstate))
 
 (local SlideshowView (View:extend))
 (fn SlideshowView.parse [slides]
@@ -10,31 +11,59 @@
     (icollect [_ elem (ipairs slide)]
       (match (type elem)
         (where :table elem.style) (do (set style elem) nil)
-        :table elem
+        :table (if elem.button (lume.merge style elem) elem)
         :string (lume.merge style {:text elem})))))
 
+(fn slides-target [slides]
+  (var target 0)
+  (each [_ slide (ipairs slides)]
+    (each [_ elem (ipairs slide)]
+      (when elem.target (set target (+ target elem.target)))))
+  target)
+
 (fn SlideshowView.new [self slides]
   (SlideshowView.super.new self)
+  (attach-imstate self)
   (set self.slides slides)
+  (set self.total-target (slides-target slides))
   (set self.imagecache {})
   (set self.islide 1)
   (set self.ielem 0)
+  (set self.cleanup {})
+  (self:cleanup-slide)
   (self:advance))
 
+(fn SlideshowView.cleanup-slide [self]
+  (each [_ f (pairs self.cleanup)] (f))
+  (set self.cleanup {})
+  (set self.current-target (slides-target (lume.slice self.slides 1 self.islide)))
+  (set self.sections (icollect [_ slide (ipairs self.slides)]
+                       (let [{: section} (or (lume.match slide #$1.section) {})] section)))
+  (var isection-current 0)
+  (set self.islide-to-isection (icollect [_ slide (ipairs self.slides)]
+                                 (let [{: section} (or (lume.match slide #$1.section) {})]
+                                   (when section (set isection-current (+ isection-current 1)))
+                                   isection-current))))
+
 (fn SlideshowView.next-slide [self]
   (set self.islide (if (>= self.islide (length self.slides)) 1 (+ self.islide 1)))
   (set self.ielem 0)
+  (self:cleanup-slide)
   (self:advance))
 
 (fn SlideshowView.prev-slide [self]
   (set self.islide (if (<= self.islide 1) (length self.slides) (- self.islide 1)))
   (set self.ielem (+ 1 (length (. self.slides self.islide))))
+  (self:cleanup-slide)
   (self:back))
 
 (fn SlideshowView.ielemNext [self ielem di]
   (let [slide (. self.slides self.islide)
         elem (. slide ielem)]
     (when elem
+      (when elem.action
+        (if (= di 1) (tset self.cleanup ielem (elem:action))
+            (. self.cleanup ielem) ((. self.cleanup ielem))))
       (if elem.pause-after ielem
         (self:ielemNext (+ ielem di) di)))))
 
@@ -77,7 +106,16 @@
     lines))
 
 (fn SlideshowView.render-element [self element y]
-  (if element.text
+  (if element.button
+      (let [(pressed yNext) (textbutton self
+                                        element.text
+                                        (+ self.position.x (self:justify element (element.font:get_width element.text)))
+                                        y
+                                        element.font)]
+        (when pressed (element:button))
+        (self:next-y element (- yNext y) y))
+
+      element.text
       (let [lines (self:word-wrap element)
             line-height (element.font:get_height)
             full-height (+ (* line-height (length lines)) (* style.padding.y (- (length lines) 1)))]
@@ -102,6 +140,47 @@
   (each [ielem element (ipairs (. self.slides self.islide)) :until (> ielem self.ielem)]
     (set y (self:render-element element (self:this-y element y)))))
 
+; timer
+(fn SlideshowView.elapsed [self]
+  (if self.elapsed-time self.elapsed-time
+      self.start-time   (- (system.get_time) self.start-time)
+                        0))
+
+(fn SlideshowView.toggle-timer [self]
+  (if (= self.start-time nil)
+      (set self.start-time (system.get_time))
+
+      (= self.elapsed-time nil)
+      (set self.elapsed-time (self:elapsed))
+
+      (do (set self.start-time (- (system.get_time) self.elapsed-time))
+          (set self.elapsed-time nil))))
+
+(fn SlideshowView.reset-timer [self]
+  (set self.elapsed-time nil)
+  (set self.start-time nil))
+
+(fn time [seconds]
+  (let [sign (if (< seconds 0) "-" "")
+        seconds (math.abs seconds)
+        m (math.floor (/ seconds 60))
+        s (% seconds 60)]
+    (string.format "%s%d:%02d" sign m s)))
+
+; status bar
+(fn SlideshowView.status_items [self {: separator : separator2}]
+  (let [full (renderer.font.load "presentation/font/PrintChar21.ttf" (* 14 SCALE))
+        thin (renderer.font.load "presentation/font/PRNumber3.ttf" (* 14 SCALE))
+        elapsed (self:elapsed)
+        left [full "\xE2\x8C\xA5 " thin]
+        right [thin (time (- self.total-target elapsed))
+               full " \xE2\x8C\x9B "
+               thin (time (- self.current-target elapsed))]]
+    (each [isection section (ipairs self.sections)]
+      (when (> isection 1) (lume.push left style.dim " > "))
+      (lume.push left (if (= isection (. self.islide-to-isection self.islide)) style.text style.dim) section))
+    (values left right)))
+
 (fn SlideshowView.get_name [self] "] KFest 2021")
 
 SlideshowView

presentation/slides.fnl

@@ -1,91 +1,214 @@
 (local util (require :lib.util))
 (local lume (require :lib.lume))
 (local {: parse} (util.require :presentation.engine))
+(local core (require :core))
 (local style (require :core.style))
+(local TileEditView (require :editor.tileedit))
+(local MapEditView (require :editor.mapedit))
+(local PortraitEditView (require :editor.portraitedit))
+(local FontEditView (require :editor.fontedit))
+(local ScreenEditView (require :editor.screenedit))
+(local files (require :game.files))
+(local link (require :link))
+
 (local h
   {:style true
-   :font (renderer.font.load "presentation/font/PrintChar21.ttf" (* 64 SCALE))
+   :font (renderer.font.load "presentation/font/PrintChar21.ttf" 64)
    :color style.caret
    :justify :center
-   :topPadding (* style.padding.y 2)
+   :topPadding 14
    :lowerPadding 64})
 (local **
   {:style true
-   :font (renderer.font.load "presentation/font/PRNumber3.ttf" (* 32 SCALE))
+   :font (renderer.font.load "presentation/font/PRNumber3.ttf" 32)
    :color style.text
    :justify :left
+   :lowerPadding 7
    :pause-after true})
-(fn p [style] (lume.merge style {:pause-after true}))
-(fn np [style] (lume.merge style {:pause-after false}))
+(fn p [style ?text] (lume.merge style {:pause-after true} (if ?text {:text ?text :style false})))
+(fn np [style ?text] (lume.merge style {:pause-after false} (if ?text {:text ?text :style false})))
 
 (fn bgimg [filename] {:image filename :justify :center :overlay true :alpha 0.3 :topPadding 0})
 
+(fn view-cleanup [view]
+  (let [root core.root_view.root_node
+        node (root:get_node_for_view view)]
+    (when node (node:close_active_view root))))
+
+(fn split-and-open [self f]
+  (let [focused-view core.active_view
+        focused-node (core.root_view:get_active_node)
+        _ (when self.split (focused-node:split self.split))
+        view (f self)
+        node (core.root_view:get_active_node)]
+    (when (= (core.root_view.root_node:get_node_for_view view) nil) (node:add_view view))
+    (when self.split (core.set_active_view focused-view)) ; don't switch focus
+    #(view-cleanup view)))
+
+(fn openview [f ?extra] (lume.merge {:action #(split-and-open $1 f)} (or ?extra {})))
+(fn openfile [filename ?extra]
+  (openview #(let [ldoc (core.open_doc filename)
+                   view (core.root_view:open_doc ldoc)]
+               (when $1.line (view:scroll_to_line $1.line))
+               view)
+            ?extra))
+
+(fn boot-game []
+  (let [p (util.reload :game)]
+    (util.in-coro (fn [] (link:switch :mame)
+                         (link.machine:run)
+                         (util.waitfor #(link.machine:connected?))
+                         (p:upload link.machine)
+                         (link.machine:launch p)))
+    nil))
+
+(fn vm-eval [...]
+  (let [prg (require :game)
+        overlay (prg.vm:gen-eval-prg [:vm ...])]
+    (link.machine:overlay overlay)
+    nil))
+
 (parse [
-  [h "" ""
-     "Honeylisp" ""
+  [h "" "" ""
+     "Honeylisp"
+     "" "" ""
    (np **) "Jeremy Penner"
            "https://spindleyq.itch.io/"
            "https://blog.information-superhighway.net/"
            "https://bitbucket.org/SpindleyQ/honeylisp"
            "https://gamemaking.social/@SpindleyQ"
            "https://twitter.com/SpindleyQ"
-   {:pause-after true}]
-  [(bgimg "presentation/pics/pete286.jpeg")
-   h "Some Background"
-   ** "In 2019 I built a 16-bit MS-DOS game engine."
-      "* Built on hardware"
-      "* Using only period-appropriate software (Turbo C, NeoPaint)"
-      "* Powered by Forth"
-      "* Integrated custom tools"
-      "* Interactive development via serial terminal"]
+   {:pause-after true}
+   {:target 30 :section :Intro}]
+  [h  "Honeylisp is hard to explain"
+   ** "It is an experimental programming environment designed to enable a productive Apple // game development workflow"
+      "* Built with https://fennel-lang.org/"
+      "* Extends the lite text editor https://github.com/rxi/lite"
+      {:image "presentation/pics/assembly-markup.png" :justify :center}
+      "* Built all tools from scratch from the assembler up"
+      "* Not command-line driven - all tools, including the assembler / compiler, run _inside_ the editor"
+      (openfile :presentation/slides.fnl {:split :right :line 89})
+      "  * Including this presentation!"
+   {:target 150}]
+  [(bgimg "presentation/pics/boot-tower.jpeg")
+   {:action #(files.reload :neuttower/game.json)}
+   h  "Neu] [ower"
+   ** "A small puzzle adventure game!"
+      "Magic Trick #1: Assemble the game and poke it directly into emulated RAM"
+      {:action boot-game}
+      "--== D E M O ==--"
+   {:target 240}]
+  [h "Explain this voodoo!"
+   ** "Directly inspired by Dagen Brock's 2016 KFest talk on GSPlus"
+      "Ended up using MAME - Lua plugin system exposes EVERYTHING"
+      "Use Jeejah nREPL server library with custom nREPL client"
+      "The assembler running inside the editor means the output is a rich object, not a file"
+    {:target 60}]
+  [h "Hot-Code Reload"
+   ** "What if I could preserve the current runtime state but rewrite the code?"
+      (openfile :neuttower/level1.fnl {:split :right :line 59})
+      "Magic Trick #2: Areas of memory can be marked as 'preserved' when new code is uploaded"
+   {:target 180}]
   [(bgimg "presentation/pics/ggj2020.jpeg")
-   h "Neut Tower"
-   ** "In 2020, I did the Global Game Jam on my 286."
-      "Finished 'Shareware Episode 1' a couple of months later."]
-  [h "The Idea"
-   ** "What if I took a similar DIY approach with modern tools?"
-      "* I'd done Forth; what about Lisp?"
-      "* How far can I push fast iterative development?"
-      "* Could I integrate an editor?"
-      "* How can I leverage emulation?"]
-  [h "Honeylisp"
-   ** "* Written in Fennel, a Lisp that compiles to Lua"
-      "* Assembler"
-      "* Forth-like 'virtual machine' / inner interpreter"
-      "* 'lite' editor, ported to love2d"
-      "  * Integrated custom editors"
-      "* MAME integration"
-      "  * Upload new builds directly into RAM"
-      "  * Interactive code injection"
-      "  * Hot code reload"
-      "* Tape upload"
-      "* ProDOS disk image generation"]
-  ;; DEMO before tech dive
-  [h "Assembler"
-   ** "Represent instructions using Fennel data literals"
-      "  [:lda 0xff]"
-      "Represent labels with Fennel strings"
-      "  :loop [:bne :loop]"
-      "Lexical scope with nested blocks"
-      "  [:block :loop (generate-loop-code) [:bne :loop]]"]
-  [h "Wait WTF Is An Assembler"
-   ** "It's just converting mnemonics to bytes, right?"
-      {:image "presentation/pics/assembly-markup.png" :justify :center :pause-after true}
-      "Whoooops, actually the hard part is converting labels to addresses"
-      "Zero-page instructions are a different size, which messes up data layout!"
-      "Initial pass is needed to gather all symbols to determine sizes"
-      "What about data?"
-      "  [:db 123] [:dw 12345] [:bytes \"HELLO WORLD\"] [:ref :hello]"
-      "Must be able to line up bytes on page boundaries"
-      "  [:align 0x100]"]
-  [h "Virtual Machine"
-     {:image "presentation/pics/thinkhard.png" :justify :center}
-   ** "Not super keen on writing a complicated compiler"
-      "I'm already very comfortable with Forth"
-      "Let's build a stack machine!"
-      "\"Direct threaded\" inner interpreter"
-      "\"Immediate words\" can be Fennel functions that generate code!"]
-  [h "Extensible Assembler??"
-   ** "How do you turn code into bytes?"
-      "  [:vm 1 2 :+ :.]"]
+   h "Interactive Execution"
+   ** "What if I could interactively try out new code while my game was running?"
+   (np **) "Magic Trick #3"
+      {:button #(vm-eval :mixed) :text ":mixed"}
+      {:button #(vm-eval :hires) :text ":hires"}
+      {:button #(vm-eval 1 2 :+ :.) :text "1 2 :+ :."}
+      {:button #(vm-eval :jaye-yx :get :.) :text ":jaye-yx :get :."}
+      {:button #(vm-eval :earthquake) :text ":earthquake"}
+      {:pause-after true}
+   {:target 180}]
+  [h "The Tools"
+   ** {:image "presentation/pics/retro-game-dev-quote.png" :justify :center :pause-after true}
+      {:action #(files.reload :neuttower/game.json)}
+      "14x16 tile editor"
+      (openview #(TileEditView))
+      "Font editor"
+      (openview #(FontEditView))
+      "Portrait editor"
+      (openview #(PortraitEditView))
+      "Map editor"
+      (openview #(MapEditView))
+      "Full-screen bitmap editor"
+      (openview #(ScreenEditView :neuttower/title.screen) {:pause-after true})
+   {:target 300 :section "Tooling"}]
+  [h "Editing Editors With My Editor"
+   ** "Lua provides a very dynamic environment"
+      (openview #(MapEditView))
+      (openfile :editor/mapedit.fnl {:split :right :line 235})
+      "Downside:"
+      {:image "presentation/pics/bsod.png" :justify :center :pause-after true}
+   {:target 180}]
+  [(bgimg "presentation/pics/bitsy.png")
+   {:action #(files.reload :bitsy/game.json)}
+   h "8-Bitsy"
+   ** "Bitsy is a popular free, accessible, web-based game-making tool"
+   {:action boot-game}
+      "Spring Lisp Game Jam - 10 days to hack"
+      "Could I make my tools a little less... programmer-y?"
+      (openview #(MapEditView) {:pause-after true})
+   {:target 180 :section "Branching Out"}]
+  [h "Thanks!"
+  (openfile :neuttower/level6.fnl {:split :right :line 164})
+   (np **) "Questions?"
+           {:topPadding 128}
+           "Jeremy Penner"
+           "https://spindleyq.itch.io/"
+           "https://blog.information-superhighway.net/"
+           "https://bitbucket.org/SpindleyQ/honeylisp"
+           "https://gamemaking.social/@SpindleyQ"
+           "https://twitter.com/SpindleyQ"
+           {:pause-after true :section "Thanks!"}]
 ])
+
+;   [(bgimg "presentation/pics/pete286.jpeg")
+;    h "Some Background"
+;    ** "2019: Built a 16-bit MS-DOS game engine, using only retro hardware and software."
+;       " * Driven by a custom Forth interpreter"
+;    {:target 90}]
+;   [(bgimg "presentation/pics/ggj2020.jpeg")
+;    h  "Neut Tower"
+;    ** "2020: Created Neut Tower as part of two game jams.
+; * Global Game Jam - One weekend - Feb 2020 - First two rooms
+; * MS-DOS Game Jam - 1.5 months - April 2020 - 'Shareware Episode 1'"
+;    {:target 60}]
+
+;   [h "What is this unholy abomination?"
+;    ** "Lisp and Forth?!"
+;       {:image "presentation/pics/thinkhard.png" :justify :center}
+;       "Not super keen on writing a complicated compiler"
+;       " * \"Direct threaded\" inner interpreter"
+;       "Forth allows efficient, composable, interactive code"
+;    {:target 60}]
+
+;   [h "Wait WTF Is An Assembler"
+;    ** "It's just converting mnemonics to bytes, right?"
+;       "Whoooops, actually the hard part is converting labels to addresses"
+;       "Zero-page instructions are a different size, which messes up data layout!"
+;       "Initial pass is needed to gather all symbols to determine sizes"
+;    {:target 60}]
+
+;   [h "Step 5: Running on Hardware"
+;    ** "I have a IIgs with a serial cable - I can poke bytes in directly from the monitor"
+;       "]IN#2\n]PR#2\n]CALL-151"
+;       "Easy to send bytes faster than the monitor can process them"]
+;   [h  "Audio"
+;    ** "I have a II+ with a cassette port"
+;       "LÖVE2D is a game engine - my editor can generate audio and play it back immediately"
+;       "Need to generate a BASIC program to bootstrap my machine code"
+;       (openfile :asm/tape.fnl {:split :right})
+;       "  [:basic [10 :call :2061]]"
+;       "Future work: Apple Game Server fastloader"]
+;   [(bgimg "presentation/pics/beneath-apple-prodos.png")
+;    h  "ProDOS"
+;    ** "Disk image is a must-have for distribution"
+;       (openfile :asm/prodos.fnl {:split :right :line 132})
+;       "Of course I wrote my own disk image generation code!"
+;       "Start with a blank ProDOS disk and add to it"
+;       "Fun bugs!"
+;       "* Accidentally implemented undelete instead of inserting new files at first"
+;       "* Read the free space bitmap backwards and overwrote the OS"
+;       "* Tried to name a volume starting with a number"]
+

support/lite/plugins/statusoverride.lua

@@ -0,0 +1,12 @@
+local core = require "core"
+
+local get_items = core.status_view.get_items
+
+core.status_view.get_items = function (self)
+  if core.active_view and core.active_view.status_items then
+    return core.active_view:status_items(self)
+  else
+    return get_items(self)
+  end
+end
+

support/mame/jeejah/init.lua

@@ -8,7 +8,7 @@ if package.path:find("vendor/jeejah/") == nil then
 
   local fennel = require "fennel"
   fennel.path = './?.fnl;' .. modpath .. "/../../../vendor/jeejah/?.fnl"
-  table.insert(package.searchers, fennel.make_searcher({correlate=true}))
+  table.insert(package.loaders or package.searchers, fennel.make_searcher({correlate=true}))
 end
 
 local fennel = require "fennel"

vendor/lite/data/plugins/statusoverride.lua

@@ -0,0 +1 @@
+../../../../support/lite/plugins/statusoverride.lua