Arrow key support in Neut Tower

(todo: investigate luarocks)

bitsy/boop.fnl

@@ -1,4 +1,4 @@
-(local {: vm} (require :game.defs))
+(local {: vm} (require :bitsy.defs))
 
 (local speaker :0xc030)
 (vm:def :blipmem ; count p --

bitsy/defs.fnl

@@ -154,7 +154,7 @@
   (local level prg) ; todo: (asm.new prg) - if we want to load levels as an overlay
   (local org level.vm.code) ; (level:org org.level.org) - if we want to give level data a stable loxation
   (local map (. files.game.levels ilevel))
-  (local entity (require :game.entity))
+  (local entity (require :bitsy.entity))
   (append-map map org label)
   (entity.append-from-map map org label)
   (set level.vm.code org)

bitsy/disk.fnl

@@ -3,7 +3,7 @@
 (local Prodos (require :asm.prodos))
 (local util (require :lib.util))
 (local {: lo : hi} util)
-(local {: org} (require :game.defs))
+(local {: org} (require :bitsy.defs))
 
 (fn append-boot-loader [prg]
   (local vm prg.vm)

bitsy/entity.fnl

@@ -1,6 +1,6 @@
 (local util (require :lib.util))
 (local tiles (util.require :game.tiles))
-(local {: vm : org : itile : say : say-runon : controlstate} (require :game.defs))
+(local {: vm : org : itile : say : say-runon : controlstate} (require :bitsy.defs))
 (local {: lo : hi} util)
 
 ; Entity memory layout:

bitsy/footer.fnl

@@ -1,4 +1,4 @@
-(local {: vm : org} (require :game.defs))
+(local {: vm : org} (require :bitsy.defs))
 (local {: hi : lo} (require :lib.util))
 
 (vm:def :draw-pchar ; pscreen pchar --

bitsy/gfx.fnl

@@ -1,5 +1,5 @@
 (local {: lo : hi} (require :lib.util))
-(local {: vm : mapw : maph : org} (require :game.defs))
+(local {: vm : mapw : maph : org} (require :bitsy.defs))
 
 ; Graphics routines
 (vm:def :mixed [:sta :0xc053])

bitsy/init.fnl

@@ -0,0 +1,60 @@
+(local util (require :lib.util))
+(local {: lo : hi : readjson} util)
+(local tile (util.reload :game.tiles))
+(local {: prg : vm : org : deflevel} (util.reload :bitsy.defs))
+(local files (require :game.files))
+
+(local disk (util.reload :bitsy.disk))
+
+(util.reload :bitsy.gfx)
+(util.reload :bitsy.footer)
+(util.reload :bitsy.map)
+(util.reload :bitsy.entity)
+(util.reload :bitsy.player)
+(util.reload :bitsy.boop)
+
+(tile.appendtiles org.code)
+(org.code:append [:align 0x100] :font)
+(tile.appendgfx org.code files.game.font)
+(tile.append-portraitwords vm)
+
+(vm:var :tick-count)
+(vm:word :handle-key :tick :read-key :player-key :hide-footer)
+(vm:word :tick :map-specific-tick :tick-count :get 1 :+ :tick-count :set :player-redraw :rnd :drop)
+
+(vm:var :next-level 0)
+(vm:word :load-next-level :next-level :get :dup (vm:if [:load-level 0 :next-level :set] [:drop]))
+(vm:word :load-level ; level-ptr --
+  :lit :map-ptr :set :reload-level)
+
+(vm:word :reload-level
+  :map-player-yx :player-yx :set
+  :map-specific-load
+  :full-redraw)
+
+(each [_ flag (ipairs (or files.game.flags []))]
+  (vm:var (.. :cond-var- flag) vm.false)
+  (vm:word (.. :cond- flag) (.. :cond-var- flag) :get))
+
+(each [imap _ (ipairs files.game.levels)]
+  (deflevel imap (.. :map imap)))
+
+(vm.code:append :main
+  [:jsr :reset]
+  [:jsr :interpret]
+  [:vm :hires
+    :lit :map1 :load-level
+    (vm:forever
+      (vm:hotswap-sync :full-redraw)
+      :interactive-eval-checkpoint
+      :handle-key
+    )
+    :quit])
+
+(disk.append-boot-loader prg)
+(print "assembling")
+(prg:assemble)
+(print "assembled")
+(disk.write prg)
+
+prg

bitsy/map.fnl

@@ -1,5 +1,5 @@
 (local {: lo : hi} (require :lib.util))
-(local {: vm : mapw : maph : rot8l} (require :game.defs))
+(local {: vm : mapw : maph : rot8l} (require :bitsy.defs))
 
 (vm:def :lookup-flags ; itile -- flags
   [:lda vm.TOP :x]

bitsy/player.fnl

@@ -1,7 +1,7 @@
 (local tile (require :game.tiles))
-(local {: vm : mapw : maph : itile : controlstate} (require :game.defs))
+(local {: vm : mapw : maph : itile : controlstate} (require :bitsy.defs))
 
-(local {: walkable} tile.flag-to-bit)
+(local {: walkable} (tile.flag-to-bit))
 
 (vm:word :either= ; target val1 val2 -- f
   :>rot :over := :>rot := :|)

editor/8bitsy.fnl

@@ -22,7 +22,7 @@
       (util.nested-tset action [:lines 4] (line4:sub 1 33))
       y))
   (fn [action vm]
-    (local {: say} (require :game.defs))
+    (local {: say} (require :bitsy.defs))
     (say action.character (table.unpack (lume.map action.lines #($1:upper))))))
 
 (actions.register :warp
@@ -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/init.fnl

@@ -10,6 +10,7 @@
 (local common (require :core.common))
 
 (require :editor.8bitsy)
+(require :presentation.commands)
 
 (let [commands {}]
   (each [_ name (ipairs [:tile :portrait :font :brush :map])]
@@ -20,7 +21,7 @@
   (command.add nil commands))
 
 (local fileeditors
-  {:screen {:view ScreenEditView :filefilter "^game/.*%.screen"}})
+  {:screen {:view ScreenEditView :filefilter ".*%.screen"}})
 
 (each [type {: view : filefilter} (pairs fileeditors)]
   (command.add nil

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))
@@ -93,7 +93,7 @@
   (var stripid "")
   (for [mx 1 mapw]
     (local itile (self:itile-from-xy mx my))
-    (local tile (. self.tilecache.tiles itile :gfx))
+    (local tile (?. self.tilecache.tiles itile :gfx))
     (table.insert tilestrip tile)
     (set stripid (.. stripid  (string.char itile))))
   (var sprite (. self.stripcache stripid))
@@ -115,7 +115,7 @@
       (local itile (self:itile-from-xy mx my))
       (local iobject (self:iobject-from-xy mx my))
       (when (= self.itile nil)
-        (let [player :player]
+        (each [_ player (ipairs (or files.game.players [:player]))]
           (match (. self.level player)
             {:x mx :y my} (renderer.draw_text style.font player tilex tiley style.text)))
         (love.graphics.setColor 1 1 1))
@@ -170,38 +170,44 @@
   (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))]
     (when do-new (table.insert object.steps {}))
     y))
 
+(fn advanced? [object]
+  (or object.advanced
+      (and (= object.advanced nil)
+           (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))
 
 (fn MapEditView.draw-object-editor [self x y]
   (let [object (self:object)
-        y (if object.advanced
+        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 object.advanced "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)
@@ -211,7 +217,7 @@
     (when do-delete
       (move-object self.level.objects (+ self.iobject 1) self.iobject)
       (set self.iobject nil))
-    (when do-advanced (set object.advanced (not object.advanced)))
+    (when do-advanced (set object.advanced (not (advanced? object))))
     y))
 
 (fn MapEditView.load-level [self]
@@ -231,29 +237,37 @@
   (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)
-            (set self.playerpos nil))
-        (checked y-new) (checkbox self (.. "Position " :player) (and (= self.itile nil) (= self.playerpos :player)) x (+ y-new style.padding.y))]
-    (when checked
-      (set self.itile nil)
-      (set self.playerpos :player))
-    (set y y-new))
+            (set self.playerpos nil))]
+    (set y y-new)
+    (each [_ player (ipairs (or files.game.players [:player]))]
+      (let [(checked y-new) (checkbox self (.. "Position " player) (and (= self.itile nil) (= self.playerpos player)) x (+ y style.padding.y))]
+        (when checked
+          (set self.itile nil)
+          (set self.playerpos player))
+        (set y y-new))))
+  (each [_ levelflag (ipairs (or files.game.levelflags []))]
+    (let [(checked y-new) (checkbox self levelflag (. self.level levelflag) x (+ y style.padding.y))]
+      (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

@@ -1,6 +1,7 @@
 (local GraphicsEditView (require :editor.gfxedit))
 (local style (require :core.style))
 (local tiles (require :game.tiles))
+(local files (require :game.files))
 (local tiledraw (require :editor.tiledraw))
 (local util (require :lib.util))
 (local {: mouse-inside : activate : active? : checkbox : textfield} (util.require :editor.imstate))
@@ -20,7 +21,9 @@
     (values ibyte ibit)))
 
 (fn TileView.tilesize [self] (values 16 16))
-(fn TileView.tilekeys [self] [:gfx])
+(fn TileView.tilekeys [self]
+  (if files.game.tilesets (icollect [_ key (pairs files.game.tilesets)] key)
+    [:gfx]))
 
 (fn get-byte [tile ibyte]
   (: (tile:sub (+ ibyte 1) (+ ibyte 1)) :byte))
@@ -71,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)))
-  (each [iflag flagname (ipairs tiles.flags)]
-    (self:draw-tile-flag flagname x (+ y (* (+ iflag 1) (+ pixel-size 4))))))
+    (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))]
+    (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

@@ -4,8 +4,7 @@
 
 (local files (util.hot-table ...))
 
-(local filename "game/game.json")
-
+(local default-filename "bitsy/game.json")
 
 (local encoded-tile-fields [:gfx :mask])
 (fn convert [tile field method]
@@ -13,27 +12,30 @@
   (when oldval
     (tset tile field (: oldval method)))
   tile)
-(fn convert-all [tile method]
-  (each [_ field (ipairs encoded-tile-fields)]
-    (convert tile field method))
-  tile)
+(fn convert-all [tile method root]
+  (let [encoded-tile-fields [:mask]]
+    (each [_ key (pairs (or root.tilesets {:tileset :gfx}))]
+      (table.insert encoded-tile-fields key))
+    (each [_ field (ipairs encoded-tile-fields)]
+      (convert tile field method))
+    tile))
 
-(fn tile-deserialize [tile]
+(fn tile-deserialize [tile root]
   (match (type tile)
     :string {:gfx (tile:fromhex) :flags {}}
-    :table  (convert-all tile :fromhex)))
+    :table  (convert-all tile :fromhex root)))
 
-(fn tile-serialize [tile] (convert-all (lume.clone tile) :tohex))
+(fn tile-serialize [tile root] (convert-all (lume.clone tile) :tohex root))
 
-(fn deserialize [key value]
+(fn deserialize [key value root]
   (match key
-    (where (or :tiles :portraits :font)) (tile-deserialize value)
+    (where (or :tiles :portraits :font :brushes)) (tile-deserialize value root)
     :levels (do (set value.map (value.map:fromhex)) value)
     _ value))
 
-(fn serialize [key value]
+(fn serialize [key value root]
   (match key
-    (where (or :tiles :portraits :font)) (tile-serialize value)
+    (where (or :tiles :portraits :font :brushes)) (tile-serialize value root)
     :levels (do (set value.map (value.map:tohex)) value)
     _ value))
 
@@ -42,25 +44,29 @@
     :table (lume.clone v)
     _ v))
 
-(fn files.load []
+(fn filename [] (or files.filename default-filename))
+(fn files.load [?filename]
+  (when ?filename (set files.filename ?filename))
   (set files.game
-       (if (util.file-exists filename)
-         (let [game (util.readjson filename)]
+       (if (util.file-exists (filename))
+         (let [game (util.readjson (filename))]
            (each [k v (pairs game)]
-             (tset game k (lume.map v #(deserialize k (clone $1)))))
+             (tset game k (lume.map v #(deserialize k (clone $1) game))))
            game)
          {:tiles [] :portraits [] :font [] :levels []}))
   files.game)
 
-(fn files.save []
+(fn files.save [?filename]
+  (when ?filename (set files.filename ?filename))
   (let [game {}]
     (each [k v (pairs files.game)]
-      (tset game k (lume.map v #(serialize k (clone $1)))))
-    (util.writejson filename game)))
+      (tset game k (lume.map v #(serialize k (clone $1) files.game))))
+    (util.writejson (filename) game)))
 
 (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)]
@@ -71,12 +77,15 @@
     (util.nested-tset files [:tilecaches key] (new-cache files.game key)))
   (. files.tilecaches key))
 
-(fn files.reload []
-  (files.load)
+(fn files.reload [?filename]
+  (files.load ?filename)
   (when files.tilecaches
     (each [key cache (pairs files.tilecaches)]
       (cache:load (. files.game key)))))
 
+(fn files.module []
+  (or files.game.module (: (filename) :match "^[^/]+")))
+
 (when (= files.game nil)
   (files.load))
 

game/init.fnl

@@ -1,60 +1,5 @@
-(local util (require :lib.util))
-(local {: lo : hi : readjson} util)
-(local tile (util.reload :game.tiles))
-(local {: prg : vm : org : deflevel} (util.reload :game.defs))
 (local files (require :game.files))
+(local util (require :lib.util))
 
-(local disk (util.reload :game.disk))
+(util.reload (files.module))
 
-(util.reload :game.gfx)
-(util.reload :game.footer)
-(util.reload :game.map)
-(util.reload :game.entity)
-(util.reload :game.player)
-(util.reload :game.boop)
-
-(tile.appendtiles org.code)
-(org.code:append [:align 0x100] :font)
-(tile.appendgfx org.code files.game.font)
-(tile.append-portraitwords vm)
-
-(vm:var :tick-count)
-(vm:word :handle-key :tick :read-key :player-key :hide-footer)
-(vm:word :tick :map-specific-tick :tick-count :get 1 :+ :tick-count :set :player-redraw :rnd :drop)
-
-(vm:var :next-level 0)
-(vm:word :load-next-level :next-level :get :dup (vm:if [:load-level 0 :next-level :set] [:drop]))
-(vm:word :load-level ; level-ptr --
-  :lit :map-ptr :set :reload-level)
-
-(vm:word :reload-level
-  :map-player-yx :player-yx :set
-  :map-specific-load
-  :full-redraw)
-
-(each [_ flag (ipairs (or files.game.flags []))]
-  (vm:var (.. :cond-var- flag) vm.false)
-  (vm:word (.. :cond- flag) (.. :cond-var- flag) :get))
-
-(each [imap _ (ipairs files.game.levels)]
-  (deflevel imap (.. :map imap)))
-
-(vm.code:append :main
-  [:jsr :reset]
-  [:jsr :interpret]
-  [:vm :hires
-    :lit :map1 :load-level
-    (vm:forever
-      (vm:hotswap-sync :full-redraw)
-      :interactive-eval-checkpoint
-      :handle-key
-    )
-    :quit])
-
-(disk.append-boot-loader prg)
-(print "assembling")
-(prg:assemble)
-(print "assembled")
-(disk.write prg)
-
-prg

game/tiles.fnl

@@ -1,10 +1,10 @@
 (local util (require :lib.util))
 (local lume (require :lib.lume))
 (local files (require :game.files))
-(local flags [:walkable])
-(local flag-to-bit {})
-(each [iflag flag (ipairs flags)]
-  (tset flag-to-bit flag (bit.lshift 1 (- iflag 1))))
+
+(fn flags [] (or files.game.tileflags [:walkable]))
+(fn flag-to-bit []
+  (collect [iflag flag (ipairs (flags))] (values flag (bit.lshift 1 (- iflag 1)))))
 
 (fn appendgfx [org gfx ?key ?label-prefix]
   (each [_ g (ipairs gfx)]
@@ -13,14 +13,16 @@
 
 (fn appendtiles [org]
   (local tiles files.game.tiles)
-  (org:append [:align 0x100] :tileset)
-  (appendgfx org tiles)
+  (local flag-lookup (flag-to-bit))
+  (each [tileset key (pairs (or files.game.tilesets {:tileset :gfx}))]
+    (org:append [:align 0x100] tileset)
+    (appendgfx org tiles key (if (= key :gfx) nil (.. key :-))))
   (appendgfx org files.game.portraits nil :portrait-)
   (org:append :tileflags)
   (each [_ tile (ipairs tiles)]
     (var flags 0)
     (each [flag _ (pairs tile.flags)]
-      (set flags (bit.bor flags (. flag-to-bit flag))))
+      (set flags (bit.bor flags (. flag-lookup flag))))
     (org:append [:db flags])))
 
 (fn append-portraitwords [vm ?overrides]

kfest2021.md

@@ -0,0 +1,66 @@
+# Honeylisp
+
+## Introduction
+* 286 project
+* Honeylisp vision
+
+## Assembler
+### What is an assembler?
+* I _thought_ the hard part was going to be converting mnemonics to bytes
+* Turns out the hard part is actually converting labels to bytes
+* zero-page instructions are a different size!
+### How it works
+* Represent each opcode as a Fennel data literal
+* nest blocks arbitrarily - "lexical scope"
+* multi-pass
+
+## VM
+* Forth-ish stack machine
+* "direct threaded" inner interpreter
+* extend assembler with :vm directive
+* "immediate words" are just Fennel functions
+
+## Lite
+* Minimal extensible text editor built in Lua
+* love2d port
+
+## Custom Editors
+* imgui style
+* show tile editor with map editor
+* font + portrait editors based on tile editor
+* generate bytes / code with fennel functions! (maps, gfx, etc)
+
+## MAME Upload
+* Nod to Dagen Brock's 2016 KFest talk on GSPlus https://www.youtube.com/watch?v=1LzCmpAanpE
+* Integrated Jeejah networked REPL into MAME
+* Can send arbitrary Fennel code to MAME to control it
+* Poke blocks of memory over the network (nREPL uses bencode from bittorrent, which allows this to be fairly low overhead)
+
+## Live Code Injection
+* The assembled program is an object in memory, which we can extend interactively
+* We can write new code and poke it into memory while the old code is running!
+* Game code is a loop - we can have a "sync point" at the top of the loop where the state of the game is well-known
+* (demo switching video modes, printing debug output, making sounds)
+
+## Hot Reload
+* Because the assembled program is an object in memory
+
+## Tape generation
+* Benefit of building tools in a game engine - I can just output audio
+* Extended assembler to accept BASIC tokens and generate linked list of BASIC lines, so the whole thing could be bootstrapped
+
+## Disk generation
+* Take a ProDOS disk image, parse it, and add files to it
+* Generate loader program, rest of game can be loaded as an overlay
+* New disk image is generated on every build because why not? It's fast
+
+## Neu] [ower
+* Fun tricks: Random number generator (never used for gameplay purposes) = just dump a couple dozen random bytes
+
+## 8-Bitsy
+* Full "code-optional" environment
+* Kind of awkward to actually use, but it works!
+* Son drew some art
+* Improvisational game design!
+
+

lib/lume.lua

@@ -624,7 +624,7 @@ function lume.wordwrap(str, limit)
     check = limit
   end
   local rtn = {}
-  local line = ""
+  local line = str:match("^(%s*)")
   for word, spaces in str:gmatch("(%S+)(%s*)") do
     local s = line .. word
     if check(s) then
@@ -694,7 +694,7 @@ function lume.hotswap(modname)
     local oldmt, newmt = getmetatable(old), getmetatable(new)
     if oldmt and newmt then update(oldmt, newmt) end
     for k, v in pairs(new) do
-      if type(v) == "table" then update(old[k], v) else old[k] = v end
+      if type(v) == "table" and type(old[k]) == "table" then update(old[k], v) else old[k] = v end
     end
   end
   local err = nil

neuttower/boop.fnl

@@ -0,0 +1,86 @@
+(local {: vm} (require :neuttower.defs))
+
+(local speaker :0xc030)
+(vm:def :blipmem ; count p --
+  [:block
+    [:lda [vm.ST1 :x]]
+    [:tay]
+  :sample
+    [:lda speaker]
+    [:lda [vm.TOP :x]]
+    [:inc vm.TOP :x]
+    [:bne :wait]
+    [:inc vm.TOPH :x]
+  :wait
+    [:clc] [:adc 1]
+    [:bne :wait]
+    [:dey]
+    [:bne :sample]]
+    (vm:drop) (vm:drop))
+
+(vm:def :bliptone ; duration-f1 f2 --
+  [:block
+    [:lda vm.ST1H :x]
+    [:sta vm.W]
+  :top
+    [:lda speaker]
+    [:ldy vm.ST1 :x]
+  :wave1 [:dey] [:bne :wave1]
+    [:lda speaker]
+    [:lda vm.TOPH :x]
+    [:ldy vm.TOP :x] [:iny]
+  :wave2 [:dey] [:bne :wave2]
+    [:ldy 0xff]
+    [:sec] [:sbc 1] [:bcs :wave2]
+    [:dec vm.W]
+    [:bne :top]
+  (vm:drop) (vm:drop)])
+
+; 0x39a "samples" = 440hz
+(local notes {})
+(each [i note (ipairs [:a :a# :b :c :c# :d :d# :e :f :f# :g :g#])]
+  (tset notes note (- i 1)))
+(fn wavelength [note]
+  (-> 0x39a
+    (/ (math.pow 1.05946 (. notes note)))
+    (math.floor)))
+(fn octave [wvl oct]
+  (-> wvl
+    (/ (math.pow 2 (- oct 3)))
+    (math.floor)))
+(fn parse-note [n]
+  (values (n:sub 1 -2) (tonumber (n:sub -1))))
+(fn note-wavelength [n]
+  (local (note oct) (parse-note n))
+  (-> (wavelength note)
+    (octave oct)))
+(fn note [n ?duration ?timbre]
+  (local timbre (or ?timbre 0x20))
+  (local duration (or ?duration 0x10))
+  (local wvl (note-wavelength n))
+  [:vm (bit.bor (bit.lshift duration 8) timbre) (- wvl timbre) :bliptone])
+(fn notes [ns ?duration ?timbre]
+  (local result [:block])
+  (each [_ n (ipairs ns)]
+    (table.insert result (note n ?duration ?timbre)))
+  result)
+
+(vm:word :snd-explode 0x40 :lit :randombytes :blipmem)
+(vm:word :snd-dooropen (notes [:c1 :e1] 3))
+(vm:word :snd-doorclose (notes [:e1 :c1] 3))
+(vm:word :snd-term-jingle (notes [:e3 :f3 :g3] 0x20))
+(vm:word :snd-termon :snd-term-jingle (note :c4 0x20))
+(vm:word :snd-termoff :snd-term-jingle (note :c3 0x20))
+(vm:word :snd-rexx (notes [:c2 :g2 :e2 :c3] 0x08 0x08))
+(vm:word :snd-libb (notes [:d#1 :g#1 :f#1 :g1] 0x08 0x7f))
+(vm:word :snd-garbage (notes [:a5 :a3 :a2] 0x04 0xa0))
+(vm:word :snd-teleport (notes [:e4 :d#4 :d4 :g#4] 0x1a 0x50))
+
+(vm.code:append :keypad-boops)
+(each [_ n (ipairs [:c4 :c#4 :d4 :d#4 :e4 :f4 :f#4 :g4 :g#4 :a5])]
+  (vm.code:append [:dw (- (note-wavelength n) 0xd0)]))
+(vm:word :snd-keypad ; digit --
+  :dup :+ :lit :keypad-boops :+ :get 0x10d0 :swap :bliptone)
+(vm:word :snd-cheat (notes [:g4 :f#4 :d#4 :a4 :g#3 :e4 :g#4 :c5] 0x30 0x20))
+
+{: note : notes}

neuttower/bosskey.fnl

@@ -0,0 +1,59 @@
+(local util (require :lib.util))
+(local {: vm : prg : astr : style} (util.require :neuttower.defs))
+(vm:word :boss-key :textmode :page2 (vm:until :read-key) :hires :page1)
+
+; if we upload to page 2 we don't have to worry about clobbering screen holes
+(local textorg (prg:org 0x0800))
+
+(fn padding [s w style]
+  (string.rep (astr " " style) (- w (length s))))
+(fn pad [s w style]
+  (.. s (padding s w style)))
+(fn rpad [s w style]
+  (.. (padding s w style) s))
+(fn cellpad [s ?style]
+  (local textstyle (or ?style style.normal))
+  (match (type s)
+    :nil (pad "" 9 textstyle)
+    :string (pad (astr s textstyle) 9 textstyle)
+    :number (rpad (astr (.. s " ") textstyle) 9 textstyle)
+    :table (cellpad (. s 1) (. s 2))))
+(fn cells [r a b c d]
+  (.. (rpad (.. r "") 3 style.inverse)
+      (cellpad a) (cellpad b) (cellpad c) (cellpad d)))
+
+(fn generate-boss-screen-lines []
+  [(-> (astr "A16  (L) TOTAL" style.inverse)
+       (pad 38 style.inverse)
+       (.. (astr "C!" style.inverse)))
+   (.. (pad "" 38 style.inverse) (astr "24"))
+   ""
+   (cells "" ["    A" style.inverse] ["    B" style.inverse] ["    C" style.inverse] ["    D" style.inverse])
+   (cells 1 "DEFINITEL" "Y REAL WO" "RK" "")
+   (cells 2 "(NOT PLAY" "ING COMPU" "TER GAMES" ")")
+   (cells 3)
+   (cells 4 "" "HAMMERS" "BILLS" "SANDWICH")
+   (cells 5 "JANUARY" 23 "$1" "CLUB")
+   (cells 6 "FEBRUARY" 121 "$2" "REUBEN")
+   (cells 7 "MARCH" 38 "$5" "BLT")
+   (cells 8 "SMARCH" 97 "$10" "HOT DOG")
+   (cells 9 "APRIL" 555 "$20" "I SAID IT")
+   (cells 10 "WEDNESDAY" 246 "$50" "EGG SALAD")
+   (cells 11 "KEYCODE" 1337 2757 9876)
+   (cells 12 "NUMBERS" 12345 "$100" "IF I HAD")
+   (cells 13 "LETTERS" "MARMOTS" "BENJAMIN" "100 I'D")
+   (cells 14 "SYMBOLS" "^!@#%&?" "$$$$$" "EAT THEM")
+   (cells 15)
+   (cells 16 ["TOTAL" style.inverse] "TOO MANY" ["* MAGIC *" style.flashing] "ALL@ONCE")
+   (cells 17) (cells 18) (cells 19) (cells 20)])
+
+(fn bytes-from-lines [lines]
+  (var bytes (string.rep (astr " ") 0x400))
+  (each [y line (ipairs lines)]
+    (local offset (+ (* (math.floor (/ (- y 1) 8)) 0x28)
+                     (* (% (- y 1) 8) 0x80)))
+    (set bytes (util.splice bytes offset line)))
+  bytes)
+
+(textorg:append [:bytes (bytes-from-lines (generate-boss-screen-lines))])
+

neuttower/cheat.fnl

@@ -0,0 +1,36 @@
+(local {: vm : say-runon : say} (require :neuttower.defs))
+
+(fn defcheat [name ...]
+  (local cheatdata (.. name "-data"))
+  (vm.code:append cheatdata [:db 0] [:bytes name] [:db 0])
+  (vm:word name :lit cheatdata :cheatguard ...))
+
+(vm:word :pcheatnext ; cheatdata -- pchar
+  :dup :bget :inc :+)
+(vm:word :reset-cheat ; cheatdata --
+  0 :swap :bset)
+(vm:word :cheatguard ; char cheatdata -- [optional rdrop]
+  :dup :pcheatnext :bget :<rot := (vm:if ; cheatdata
+    [:dup :bget :inc :over :bset
+     :dup :pcheatnext :bget (vm:if [:drop :rdrop] [:snd-cheat :reset-cheat])]
+    [:reset-cheat :rdrop]))
+
+(defcheat :NTSPISPOPD :noclip :get :not :noclip :set)
+
+(vm.code:append :level-pointers
+  [:vm :level1 :level2 :level3 :level4 :level5 :level6])
+(defcheat :NTXYZZY
+  (say-runon :term "WARP TO ROOM #?" "(0 TO NOT CHEAT)")
+  :read-digit :hide-footer (vm:if-and [[:dup 1 :>=] [:dup 7 :<]]
+    [:dec :dup :+ :lit :level-pointers :+ :get :load-level]
+    [:drop]))
+
+(defcheat :NTCHUCK :chuck-mode :get :not :chuck-mode :set
+  :chuck-mode :get (vm:if
+    [(say :neut "CHUCK MODE ENABLED!" "* W H I N N Y *")]
+    [(say :neut "CHUCK MODE DISABLED." "BEEP BOOP.")]))
+
+(vm:word :cheat-key ; ascii --
+  (vm:if-and [[:dup (string.byte "A") :>=] [:dup (string.byte "Z") :<=]]
+    [:dup :NTSPISPOPD :dup :NTXYZZY :NTCHUCK]
+    [:drop]))

neuttower/defs.fnl

@@ -0,0 +1,184 @@
+(local util (require :lib.util))
+(local {: lo : hi : readjson} util)
+(local lume (require :lib.lume))
+(local asm (require :asm.asm))
+(local VM (require :asm.vm))
+(local tiles (require :game.tiles))
+(local files (require :game.files))
+(local Prodos (require :asm.prodos))
+
+(local prg (asm.new))
+(local vm (VM.new prg {:org 0xc00}))
+(Prodos.install-words vm)
+
+(local org {
+  :boot vm.code
+  :code (prg:org 0x4000)
+})
+
+(local mapw 20)
+(local maph 12)
+
+(local mon {
+  :hexout :0xfdda
+  :putchar :0xfded
+  :bell :0xff3a
+})
+
+
+(local controlstate {
+  :jaye 0
+  :neut 1
+  :rexx 2
+  :gord 3
+  :libb 4
+  :count 5
+})
+
+(local style {
+  :normal 0x80
+  :inverse 0x00
+  :flashing 0x40
+})
+(fn str-with-style [s stylebits]
+  (-> [(string.byte s 1 -1)]
+      (lume.map #(bit.bor (bit.band $1 0x3f) stylebits))
+      (-> (table.unpack) (string.char))))
+(fn achar [c] (bit.bor (string.byte c) style.normal))
+(fn astr [s ?style] (str-with-style s (or ?style style.normal)))
+
+(fn rot8l [n] ; clears carry
+  (local block [:block [:clc]])
+  (for [_ 1 n] (table.insert block [:block [:asl :a] [:adc 0]]))
+  block)
+
+; core graphics words needed for booting
+(vm:def :hires
+  [:sta :0xc050]
+  [:sta :0xc057]
+  [:sta :0xc052]
+  [:sta :0xc054])
+
+(vm:def :cleargfx
+  (vm:push 0x4000)
+  [:block :page
+    [:dec vm.TOPH :x]
+    [:lda 0]
+    [:block :start
+      [:sta [vm.TOP :x]]
+      [:inc vm.TOP :x]
+      [:bne :start]]
+    [:lda vm.TOPH :x]
+    [:cmp 0x20]
+    [:bne :page]]
+  (vm:drop))
+
+; a handful of debugging words
+(vm:def :.
+  [:lda vm.TOPH :x]
+  [:jsr mon.hexout]
+  [:lda vm.TOP :x]
+  [:jsr mon.hexout]
+  [:lda (achar " ")]
+  [:jsr mon.putchar]
+  (vm:drop))
+
+(vm:def :stacklen
+  (vm:reserve)
+  [:txa] [:lsr :a] [:sta vm.TOP :x]
+  [:lda 0] [:sta vm.TOPH :x])
+
+(vm:word :.s
+  :stacklen (prg:parse-addr vm.TOP) :swap
+  (vm:for :dup :get :. :inc :inc) :drop)
+
+; input words
+(vm:def :last-key ; -- key
+  (vm:reserve)
+  [:lda :0xc000]
+  [:and 0x7f]
+  [:sta vm.TOP :x]
+  [:lda 0]
+  [:sta vm.TOPH :x])
+
+(vm:def :read-key ; -- key|0
+  [:block
+    (vm:reserve)
+    [:lda :0xc000]
+    [:bmi :key-pressed]
+    [:lda 0]
+    [:sta vm.TOP :x]
+    [:sta vm.TOPH :x]
+    (vm:ret)
+  :key-pressed
+    [:and 0x7f]
+    [:sta vm.TOP :x]
+    [:lda 0]
+    [:sta vm.TOPH :x]
+    [:sta :0xc010]])
+
+; "random" numbers
+; this is used only for cosmetic purposes and short noise generation, so we can get away
+; with just including a short table of random digits rather than implementing our own
+; pseudorandom number generator
+(var randombytes "")
+(for [i 0 0x40] (set randombytes (.. randombytes (string.char (math.random 0 255)))))
+(vm.code:append :randombytes [:bytes randombytes])
+(vm:var :irandom [:db 0])
+(vm:word :rnd
+  :irandom :bget
+  :dup 1 :+ 0x3f :& :irandom :bset
+  :lit :randombytes :+ :bget)
+
+; 20x12 means full map is 240 bytes - we have an extra 16 bytes at the end for metadata
+(fn append-map [map org label]
+  (org:append
+    [:align 0x100] label
+    [:bytes map.map]
+    [:db (length map.objects)]
+    [:dw (tiles.encode-yx map.jaye)]
+    [:dw (tiles.encode-yx map.neut)]
+    [:dw (if map.gord-following (tiles.encode-yx map.jaye) 0xffff)]
+    [:jmp (if (= (or map.tickword "") "") :next map.tickword)]
+    [:jmp (if (= (or map.moveword "") "") :move-noop map.moveword)]
+    [:jmp (if (= (or map.loadword "") "") :next map.loadword)]))
+
+(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)
+(vm:word :map-neut-yx :map 243 :+ :get)
+(vm:word :map-gord-yx :map 245 :+ :get)
+(vm:word :map-specific-tick :map 247 :+ :execute)
+(vm:word :map-specific-move :map 250 :+ :execute)
+(vm:word :map-specific-load :map 253 :+ :execute)
+
+(fn deflevel [ilevel label]
+  (local level prg) ; todo: (asm.new prg) - if we want to load levels as an overlay
+  (local org level.vm.code) ; (level:org org.level.org) - if we want to give level data a stable loxation
+  (local map (. files.game.levels ilevel))
+  (local entity (require :neuttower.entity))
+  (append-map map org label)
+  (entity.append-from-map map org label)
+  (set level.vm.code org)
+  level)
+
+(fn say-runon [portrait ...]
+  (local result [:vm (.. :draw-portrait- portrait)])
+  (local lines [...])
+  (local ilineOffset (if (< (length lines) 4) 1 0))
+  (each [iline line (ipairs lines)]
+    (table.insert result [:vm (vm:str line) (.. :draw-text (+ iline ilineOffset))]))
+  result)
+
+(fn say [portrait ...]
+  (local result (say-runon portrait ...))
+  (table.insert result :dismiss-dialog)
+  result)
+
+(fn itile [label] (tiles.find-itile files.game.tiles label))
+
+(set vm.code org.code)
+
+{: vm : prg : mapw : maph : mon : org : achar : astr : style : rot8l : deflevel : say : say-runon : itile : controlstate}
+

neuttower/disk.fnl

@@ -0,0 +1,87 @@
+(local asm (require :asm.asm))
+(local VM (require :asm.vm))
+(local Prodos (require :asm.prodos))
+(local util (require :lib.util))
+(local {: lo : hi} util)
+(local {: org} (require :neuttower.defs))
+
+(fn append-boot-loader [prg]
+  (local vm prg.vm)
+  (set vm.code org.boot)
+  (set prg.files [])
+
+  (vm:word :loadfile ; length addr filename --
+    0xbb00 :open :read :drop :close)
+  (vm:word :loadscreen :cleargfx 0x2000 0x2000 :<rot :loadfile)
+
+  (vm.code:append
+    :boot
+    [:jsr :reset]
+    [:jsr :interpret]
+    [:vm :hires (vm:pstr "TITLE.SCREEN") :loadscreen])
+  (each [addr _ (pairs prg.org-to-block)]
+    (when (~= addr org.boot.org)
+      (local filename (.. "STUFF." (length prg.files)))
+      (table.insert prg.files {: filename :org addr})
+      (vm.code:append [:vm :lit [:dw #(length (. prg.org-to-block addr :bytes))] addr :lit (.. :filename (length prg.files)) :loadfile])))
+  (vm.code:append
+    [:vm :native]
+    [:jmp prg.start-symbol])
+  (each [i file (ipairs prg.files)]
+    (vm.code:append (.. :filename i) (Prodos.str file.filename))))
+
+(fn org-copier [org]
+  (local srclabel (.. :loader- org.addr))
+  ; this will always copy full pages, because it simplifies the code and we don't actually care if a little extra
+  ; garbage is tacked on to the end.
+  ; We copy the pages in reverse order, because this allows us to safely move from 0x2000 to higher memory, and we
+  ; never want to overlap with 0x2000 from lower memory, so either direction is safe
+  (local dstpage-first (hi org.addr))
+  (local dstpage-last (hi (+ org.addr (length org.bytes) -1)))
+  [:block
+    [:computed :srchi #(+ ($1:lookup-addr :ld-src) 2)]
+    [:computed :dsthi #(+ ($1:lookup-addr :st-dst) 2)]
+    [:computed :src-last #(+ ($1:lookup-addr srclabel) (* (- dstpage-last dstpage-first) 0x100))]
+    [:computed :dst-last #(+ org.addr (* (- dstpage-last dstpage-first) 0x100))]
+    [:ldx 0]
+  :ld-src [:lda :src-last :x]
+  :st-dst [:sta :dst-last :x]
+    [:inx]
+    [:bne :ld-src]
+
+    [:lda :dsthi]
+    [:cmp dstpage-first]
+    [:beq :done]
+    [:dec :srchi]
+    [:dec :dsthi]
+    [:bne :ld-src]
+  :done])
+
+(fn create-sys-loader [disk filename game]
+  (local blocks [])
+  (local prg (asm.new game))
+  (local sys (prg:org 0x2000))
+  (sys:append :loader-main)
+  (set prg.start-symbol :loader-main)
+  (sys:append (org-copier org.boot.block))
+  (sys:append [:jmp :boot])
+  (sys:append (.. :loader- org.boot.org) [:bytes org.boot.block.bytes])
+  (prg:assemble)
+  (disk:add-file (.. filename ".SYSTEM") Prodos.file-type.SYS 0x2000 sys.block.bytes))
+
+(fn write [game]
+  (local disk (Prodos "ProDOS_Blank.dsk"))
+  (disk:update-volume-header {:name "NEUT.TOWER"})
+
+  (create-sys-loader disk :NEUT game)
+
+  (disk:add-file "TITLE.SCREEN" Prodos.file-type.BIN 0x2000 (: (util.readjson "neuttower/title.screen") :fromhex))
+  (disk:add-file "ELEVATOR.SCREEN" Prodos.file-type.BIN 0x2000 (: (util.readjson "neuttower/end.screen") :fromhex))
+  (each [_ file (ipairs game.files)]
+    (disk:add-file file.filename Prodos.file-type.BIN file.org (. game.org-to-block file.org :bytes)))
+
+  (disk:write "NeutTower.dsk")
+  disk)
+
+{: write : append-boot-loader}
+

neuttower/entity.fnl

@@ -0,0 +1,234 @@
+(local util (require :lib.util))
+(local tiles (util.require :game.tiles))
+(local {: vm : org : itile : say : say-runon : controlstate} (require :neuttower.defs))
+(local {: lo : hi} util)
+
+; Entity memory layout:
+; +0 - yx
+; +2 - event handler
+; +4 - link word
+; +6 - link pointer
+
+; All entities exist in a single page in RAM - with this structure we can have up to 32
+; (players are handled specially and never require a link)
+; if we really need more we could have one page for entities and one page for link data
+; hellmaze level 2 from MS-DOS Neut Tower has 36 entities - good excuse to simplify IMO
+; The entity count for a level is stored after the map.
+
+(local ev {
+  :touch   0
+  :untouch 1
+  :act     2
+  :deact   3
+  :tog     4
+  :hack    5
+  :noop    6
+})
+
+(vm:def :lookup-entity ; i -- entity
+  [:lda vm.TOP :x]
+  [:asl :a] [:asl :a] [:asl :a] ; x8
+  [:sta vm.TOP :x]
+  [:lda :map-page] [:clc] [:adc 1]
+  [:sta vm.TOPH :x])
+(vm:word :entity-at ; yx -- entity|0
+  :>r 0 :entity-count
+  (vm:while [:dup] :dec ; entity|0 i
+    :dup :lookup-entity :get :rtop :=
+    (vm:when :lookup-entity :swap)
+  ) :drop :rdrop)
+(vm:var :responder 0)
+(vm:word :get-responder :responder :get)
+(vm:word :entity-itile :get :itile-at)
+(vm:word :responder-itile :get-responder :entity-itile)
+(vm:word :entity>do ; entity ev --
+  :over :responder :dup :get :>r :set
+  :swap 2 :+ :get :execute
+  :r> :responder :set)
+(vm:word :link-arg ; e -- a
+  6 :+ :get)
+(vm:word :linked-entity :get-responder :dup 4 :+ :get :dup (vm:if [:execute] [:drop :link-arg]))
+(vm:word :entity-at>do ; yx ev -- f
+  :>r :entity-at :dup (vm:if [:r> :entity>do vm.true] [:rdrop]))
+(vm:word :touch-entity ; yx -- f
+  ev.touch :entity-at>do)
+(vm:word :untouch-entity ; yx --
+  ev.untouch :entity-at>do :drop)
+
+(vm:word :entity-around>do ; yx ev --
+  :over 0x0100 :yx+ :over :entity-at>do :drop
+  :over 0x0001 :yx+ :over :entity-at>do :drop
+  :over 0xff00 :yx+ :over :entity-at>do :drop
+  :swap 0x00ff :yx+ :swap :entity-at>do :drop)
+
+(vm:word :set-entitytile ; e itile --
+  :swap :get :swap :update-itile)
+
+(vm:word :set-respondertile ; itile --
+  :get-responder :get :swap :update-itile)
+
+; run only when processing an ev.touch event
+(vm:word :transparent-entity-move ; -- f
+  :get-responder :get :dup :handle-general-move
+  :swap :over :not (vm:if [:move-player-to] [:drop]))
+
+(vm:var :pre-handled-tile 0)
+(vm:var :pre-handled-ev 0)
+(vm:word :handle-onoff ; ev off on --
+  :responder-itile :pre-handled-tile :set :<rot
+  :dup ev.tog := (vm:when
+    :drop :dup :responder-itile := (vm:if [ev.deact] [ev.act])
+  ) :dup :pre-handled-ev :set (vm:case
+    [ev.act :swap :drop :set-respondertile]
+    [ev.deact :drop :set-respondertile]
+    [:else :drop :drop]))
+
+(vm:word :on-handled ; xp-on xp-off --
+  :responder-itile :pre-handled-tile :get := (vm:if
+    [:drop :drop]
+    [:pre-handled-ev :get ev.act :=
+     (vm:if [:drop] [:swap :drop]) :execute]))
+
+(vm:word :activation-ev? ; ev -- f
+  :dup ev.act := :over ev.deact := :| :swap ev.tog := :|)
+(vm:word :activate-link ; ev itile-on --
+  :swap :activation-ev? (vm:if [
+    :responder-itile := (vm:if [ev.act] [ev.deact])
+    :linked-entity :swap :entity>do
+  ] [:drop]))
+
+(vm:word :walking-through-door ; ev -- ev f
+  (vm:if-and [[:is-walking?] [:dup ev.touch :=] [:responder-itile (itile :dooropen) :=]]
+    [vm.true] [vm.false]))
+
+(vm:word :door ; ev --
+  :walking-through-door (vm:if
+    [:move-to-responder :drop]
+    [(itile :doorclosed) (itile :dooropen) :handle-onoff
+     :lit :snd-dooropen :lit :snd-doorclose :on-handled]))
+
+(vm:word :exitlevel ; e --
+  :link-arg :next-level :set)
+
+(vm:word :exitdoor ; ev --
+  :walking-through-door (vm:if
+    [:drop (vm:ifchain
+       [:gord-sitting :get] [(say :jaye "I'M NOT LEAVING GORD BEHIND.")]
+       [:libb-hidden? :not] [(say :neut "IT IS INADVISABLE TO LEAVE THIS" "AREA WITHOUT RETRIEVING LIBB")]
+       [:move-to-responder :linked-entity])]
+    [:door]))
+
+(vm:word :move-to-responder :get-responder :get :move-player-to)
+(vm:word :switch ; ev --
+  (vm:if-and [[:is-rexx? :not] [:dup ev.touch :=]]
+    [:drop ev.tog :is-neut? (vm:when :move-to-responder)])
+  :dup (itile :switchoff) (itile :switchon) :handle-onoff
+  (itile :switchon) :activate-link)
+
+(vm:var :disconnected-term-attempt vm.false)
+(vm:word :term ; ev --
+  :dup ev.touch := (vm:when
+    (vm:ifchain [:is-jaye?] [:drop ev.act]
+                [:is-neut?] [:responder-itile (itile :termon) := (vm:when
+                                :linked-entity :dup :entity-itile (itile :termon) :=
+                                (vm:if [:get :move-player-to :snd-teleport]
+                                       [:drop (say :neut "DESTINATION TERMINAL" "IS DISCONNECTED")
+                                        :disconnected-term-attempt :get :not (vm:when
+                                          vm.true :disconnected-term-attempt :set
+                                          (say :neut "PLEASE CONTACT YOUR" "SYSTEM ADMINISTRATOR")
+                                          (say :neut "THIS INCIDENT HAS" "BEEN REPORTED"))]))]
+                []))
+  (itile :termoff) (itile :termon) :handle-onoff
+  :lit :snd-termon :lit :snd-termoff :on-handled)
+
+(vm:word :handle-scan ; ev --
+  :dup (itile :scanoff) (itile :scanon) :handle-onoff
+  :linked-entity :swap :entity>do)
+
+(vm:word :libb-on-responder :libb-yx :get :get-responder :get :=)
+(vm:word :scan ; ev --
+  :is-neut? (vm:if [
+    (vm:case
+      [ev.touch ev.act :handle-scan :libb-on-responder (vm:when controlstate.libb :controlstate :bset 0xffff :move-player-to controlstate.neut :controlstate :bset) :move-to-responder]
+      [ev.untouch :libb-on-responder :not (vm:when ev.deact :handle-scan)]
+      [ev.hack vm.true :hack-handled :set
+               ev.act :handle-scan
+               :snd-libb
+               controlstate.libb :controlstate :bset
+               :move-to-responder
+               controlstate.neut :controlstate :bset
+               (say :libb "NO SWEAT.")]
+      [:else])
+  ] [:drop]))
+
+(vm:word :rexx ; ev --
+  ev.touch := (vm:when
+    (vm:if-and [[:is-neut?] [:responder-itile (itile :t-rexx) :=]]
+      [0xffff :move-player-to
+       (itile :t-rexxstop) :set-respondertile
+       :get-responder :set-rexx :snd-rexx]
+      [(vm:if-and [[:is-rexx?] [:responder-itile (itile :t-rexxstop) :=]]
+         [0xffff :move-player-to
+          (itile :t-rexx) :set-respondertile
+          0 :set-rexx :move-to-responder])])))
+
+
+(vm:word :read-digit ; -- digit
+  (vm:while [:read-key :dup 0x3a :< :over 0x30 :>= :& :not] :drop) 0x30 :-)
+
+(vm:word :keypad-digit ; pscreen -- n
+  :read-digit :swap :over :draw-digit :dup :snd-keypad)
+(vm:word :next-digit ; pscreen n -- pscreen n
+  :shl4 :over :keypad-digit :+ :swap 1 :+ :swap)
+(vm:word :draw-single-keypad-hash ; pscreen -- pscreen
+  :dup (string.byte "#") :draw-char 1 :+)
+(vm:word :read-keypad ; -- n
+  0x23e2 :dup
+  :draw-single-keypad-hash :draw-single-keypad-hash :draw-single-keypad-hash :draw-single-keypad-hash :drop
+  0 :next-digit :next-digit :next-digit :next-digit :swap :drop :cleartext)
+(vm:word :keypad ; ev code --
+  :>r
+  :dup ev.touch := (vm:when
+    :is-jaye? (vm:when
+      :responder-itile (itile :t-keyoff) := (vm:if
+        [(say-runon :pady "ENTER YOUR 4-DIGIT DOOR CODE!" "AND HAVE A SUPER DAY!")
+         :read-keypad :rtop := (vm:if
+           [(say :pady "THAT'S RIGHT! HOORAY!" "YOU GET A GOLD STAR!")
+            :drop ev.act]
+           [(say :pady "OHHH, SORRY! THAT'S NOT IT." "BETTER LUCK NEXT TIME!")])]
+        [(say :pady "OH HI AGAIN! I MISSED YOU TOO!")]))
+    :is-neut? (vm:when :move-to-responder))
+  :rdrop
+  :dup :evhack? (vm:when :drop ev.act)
+  :dup (itile :t-keyoff) (itile :t-keyon) :handle-onoff
+  (itile :t-keyon) :activate-link)
+
+(vm:var :hack-handled vm.false)
+(vm:word :evhack? ; e -- f
+  ev.hack := (vm:if [vm.true :hack-handled :set vm.true] [vm.false]))
+
+(vm:word :trigger-sidekick
+  (vm:if-and [[:is-jaye?] [:gord-sitting :get]]
+    [:gord-yx :get ev.touch :entity-around>do]
+    [(vm:if-and [[:is-neut?] [:libb-present :get] [:libb-hidden?]]
+       [vm.false :hack-handled :set
+        :neut-yx :get ev.hack :entity-at>do :drop
+        :hack-handled :get :not (vm:when
+          (say :libb "DON'T THINK I CAN HACK THAT."))])]))
+
+(fn append-from-map [map entity-org prefix]
+  (entity-org:append [:align 0x100])
+  (each [ientity entity (ipairs map.objects)]
+    (when entity.name
+      (entity-org:append entity.name))
+    (entity-org:append
+      (.. prefix "-entity-" ientity)
+      [:db (- entity.x 1)] [:db (- entity.y 1)]
+      [:ref entity.func]
+      (if (and entity.linkword (> (length entity.linkword) 0)) [:ref entity.linkword] [:dw 0])
+      (if entity.link       [:ref (.. prefix "-entity-" entity.link)]
+          entity.linkentity [:ref entity.linkentity]
+        [:dw 0]))))
+
+{: ev : append-from-map}
+

neuttower/footer.fnl

@@ -0,0 +1,55 @@
+(local {: vm : org} (require :neuttower.defs))
+(local {: hi : lo} (require :lib.util))
+
+(vm:def :draw-pchar ; pscreen pchar --
+  [:block
+    [:ldy 7] [:clc]
+  :loop
+    [:lda [vm.TOP :x]]
+    [:sta [vm.ST1 :x]]
+    [:inc vm.TOP :x]
+    [:lda vm.ST1H :x] [:adc 4] [:sta vm.ST1H :x]
+    [:dey]
+    [:bne :loop]
+  ]
+  (vm:drop) (vm:drop))
+
+(vm:def :lookup-pchar ; c -- pchar
+  [:sec]
+  [:lda vm.TOP :x]
+  [:sbc 0x20]
+  [:sta vm.TOP :x]
+  [:lda 0]
+  [:asl vm.TOP :x] [:rol :a] ;x2
+  [:asl vm.TOP :x] [:rol :a] ;x4
+  [:asl vm.TOP :x] [:rol :a] ;x8
+  [:adc #(hi ($1:lookup-addr :font))]
+  [:sta vm.TOPH :x])
+
+(vm:word :draw-char ; pscreen c --
+  :lookup-pchar :draw-pchar)
+(vm:word :draw-digit ; pscreen n --
+    0x30 :+ :draw-char)
+
+(vm:word :snooze (vm:for))
+(vm:word :textsnooze 0x30 :snooze)
+(vm:word :draw-text1 0x2257 :draw-text)
+(vm:word :draw-text2 0x22d7 :draw-text)
+(vm:word :draw-text3 0x2357 :draw-text)
+(vm:word :draw-text4 0x23d7 :draw-text)
+(vm:word :draw-text ; st pscreen --
+  (vm:while [:over :bget :dup] ; st pscreen c
+    :over :swap :draw-char ; st pscreen
+    :textsnooze
+    :inc :swap :inc :swap)
+  :drop :drop :drop)
+(vm:word :cleartext
+  0x2257 :clearline 0x22d7 :clearline 0x2357 :clearline 0x23d7 :clearline)
+
+(vm:word :wait-for-return (vm:until :read-key (string.byte "\r") :=))
+(vm:word :dismiss-dialog :wait-for-return :cleartext)
+
+(vm:var :footer-displayed vm.false)
+(vm:word :show-footer :footer-displayed :get :not (vm:when vm.true :footer-displayed :set :drawfooter))
+(vm:word :hide-footer :footer-displayed :get (vm:when vm.false :footer-displayed :set :clearfooter))
+

neuttower/gfx.fnl

@@ -0,0 +1,133 @@
+(local {: lo : hi} (require :lib.util))
+(local {: vm : mapw : maph : org} (require :neuttower.defs))
+
+; Graphics routines
+(vm:def :mixed [:sta :0xc053])
+(vm:def :textmode [:sta :0xc051])
+(vm:def :page1 [:sta :0xc054])
+(vm:def :page2 [:sta :0xc055])
+
+; starting address:
+; 0x2000 + (x*2) + (y%4 * 0x100) + ((y/4) * 0x28)
+; x between 0-19
+; y between 0-12
+; yx - 16-bit value, low byte x, high byte y
+(vm.code:append :screeny-lookup [:bytes "\0\040\080"])
+(vm:def :yx>screen ; yx -- p
+  [:lda vm.TOPH :x]         ; a=y
+  [:lsr :a] [:lsr :a]       ; a=y/4
+  [:tay]                    ; y=y/4
+  [:lda 0x03]
+  [:and vm.TOPH :x]         ; a=y%4
+  [:ora 0x20]               ; a=0x20 + y%4
+  [:sta vm.TOPH :x]         ; high byte is set (and y is wiped)
+  [:lda vm.TOP :x]          ; a=x
+  [:asl :a]                 ; a = x*2
+  [:clc]
+  [:adc :screeny-lookup :y] ; a=x*2 + (y/4)*0x28
+  [:sta vm.TOP :x]          ; low byte is set
+)
+
+; note: the graphical tile data must not cross a page boundary
+; (this happens automatically because each tile is 32 bytes and we
+; start them on a page; this lets lookup-tile be fast)
+(fn draw-block []
+  [:block
+    [:clc]
+    [:ldy 8]
+  :loop
+    [:lda [vm.TOP :x]]
+    [:sta [vm.ST1 :x]]
+    [:inc vm.TOP :x]
+    [:lda vm.ST1H :x]
+    [:adc 4]
+    [:sta vm.ST1H :x]
+    [:dey]
+    [:bne :loop]])
+
+(fn draw-vertical-block []
+  [:block
+    (draw-block)
+    [:lda vm.ST1H :x]
+    [:sbc 31] ; with carry clear this is 32
+    [:sta vm.ST1H :x]
+    [:lda vm.ST1 :x]
+    [:ora 0x80]
+    [:sta vm.ST1 :x]
+    (draw-block)])
+
+(vm:def :drawtile ; p gfx --
+  (draw-vertical-block)
+  [:lda vm.ST1H :x]
+  [:sbc 31]
+  [:sta vm.ST1H :x]
+  [:lda vm.ST1 :x]
+  [:sbc 0x7f]
+  [:sta vm.ST1 :x]
+  (draw-vertical-block)
+  (vm:drop) (vm:drop))
+
+(vm:def :clearline ; pscreen --
+  [:lda vm.TOP :x] [:sta vm.W]
+  [:lda vm.TOPH :x] [:sta vm.WH]
+  (vm:drop)
+  [:block
+    :row
+      [:ldy 0x27] [:lda 0]
+    :start
+      [:sta [vm.W] :y]
+      [:dey]
+      [:bpl :start]
+
+      [:lda vm.WH]
+      [:cmp 0x3c]
+      [:bcs :done]
+      ; cmp has cleared carry for us here
+      [:lda 4] [:adc vm.WH] [:sta vm.WH]
+      [:bcc :row]
+    :done])
+
+(vm:word :drawfooter
+  0x39d0 :clearline
+  0x2250 :clearline 0x22d0 :clearline 0x2350 :clearline 0x23d0 :clearline)
+
+(vm:word :drawmaprow ; pscreen pmap -- pmap
+  mapw (vm:for
+    :2dup :bget :lookup-tile :drawtile
+    :inc :swap :inc :inc :swap) :swap :drop)
+
+(vm:word :drawmap
+  :map 0x0c00 (vm:until 0x100 :-
+    :dup :yx>screen ; pmap yx pscreen
+    :<rot :drawmaprow :swap ; pmap yx
+  :dup :not) :drop :drop)
+
+(vm:word :clearfooter
+  :map 0x0300 (vm:until 0x100 :-
+    :dup 0x0900 :+ :yx>screen
+    :<rot :drawmaprow :swap
+  :dup :not) :drop :drop :player-redraw)
+
+(vm.code:append :tilepage [:db #(hi ($1:lookup-addr :jaye-tileset))])
+(vm:def :lookup-tile ; itile -- ptile
+  ; each tile is 32 bytes; 2^5
+  ; we save some cycles by storing the indices as lllhhhhh, so we don't need to shift them'
+  [:lda vm.TOP :x] [:tay]
+  [:and 0x1f]
+  [:clc] [:adc :tilepage]
+  [:sta vm.TOPH :x]
+  [:tya] [:and 0xe0]
+  [:sta vm.TOP :x])
+(vm:def :set-human-tileset
+  [:lda #(hi ($1:lookup-addr :jaye-tileset))]
+  [:sta :tilepage])
+(vm:def :set-prog-tileset
+  [:lda #(hi ($1:lookup-addr :neut-tileset))]
+  [:sta :tilepage])
+
+(vm:word :draw-portrait ; pgfx
+  0x2252 :over :drawtile
+  0x2352 :over 32 :+ :drawtile
+  0x2254 :over 64 :+ :drawtile
+  0x2354 :swap 96 :+ :drawtile)
+

neuttower/init.fnl

@@ -0,0 +1,65 @@
+(local util (require :lib.util))
+(local {: lo : hi : readjson} util)
+(local tile (util.reload :game.tiles))
+(local files (require :game.files))
+(local {: prg : vm : org} (util.reload :neuttower.defs))
+
+(local disk (util.reload :neuttower.disk))
+
+(util.reload :neuttower.gfx)
+(util.reload :neuttower.footer)
+(util.reload :neuttower.map)
+(util.reload :neuttower.entity)
+(util.reload :neuttower.player)
+(util.reload :neuttower.boop)
+(util.reload :neuttower.cheat)
+
+(tile.appendtiles org.code)
+(org.code:append [:align 0x100] :font)
+(tile.appendgfx org.code files.game.font)
+(tile.append-portraitwords vm {:neut #[:vm :chuck-mode :get (vm:if [:lit :portrait-chuck] [:lit :portrait-neut])]})
+
+(util.reload :neuttower.level1)
+(util.reload :neuttower.level2)
+(util.reload :neuttower.level3)
+(util.reload :neuttower.level4)
+(util.reload :neuttower.level5)
+(util.reload :neuttower.level6)
+
+(util.reload :neuttower.bosskey)
+
+(vm:var :tick-count)
+(vm:word :handle-key :tick :read-key :dup :cheat-key :player-key :hide-footer)
+(vm:word :tick :map-specific-tick :tick-count :get 1 :+ :tick-count :set :player-redraw :rnd :drop)
+
+(vm:var :next-level 0)
+(vm:word :load-next-level :next-level :get :dup (vm:if [:load-level 0 :next-level :set] [:drop]))
+(vm:word :load-level ; level-ptr --
+  :lit :map-ptr :set :reload-level)
+
+(vm:word :reload-level
+  :map-jaye-yx :jaye-yx :set
+  :map-neut-yx :neut-yx :set
+  :map-gord-yx :gord-yx :set
+  0 :gord-dir :set
+  0xffff :rexx-yx :set
+  :map-specific-load
+  :full-redraw)
+
+(vm.code:append :main
+  [:jsr :reset]
+  [:jsr :interpret]
+  [:vm :hires
+    :lit :level1 :load-level
+    (vm:forever
+      (vm:hotswap-sync :full-redraw)
+      :interactive-eval-checkpoint
+      :handle-key
+    )
+    :quit])
+
+(disk.append-boot-loader prg)
+(prg:assemble)
+(disk.write prg)
+
+prg

neuttower/level1.fnl

@@ -0,0 +1,69 @@
+(local {: readjson} (require :lib.util))
+(local {: deflevel : say : itile : controlstate} (require :neuttower.defs))
+(local {: ev} (require :neuttower.entity))
+(local {: decode-itile : encode-yx} (require :game.tiles))
+(local files (require :game.files))
+(local level (deflevel 1 :level1))
+(local vm level.vm)
+
+(let [map (. files.game.levels 1)
+      maptiles map.map
+      furniture-yx []]
+  (for [ibyte 1 (length maptiles)]
+    (let [btile (maptiles:sub ibyte ibyte)
+          enctile (string.byte btile)
+          itile (+ (decode-itile enctile) 1)
+          mx (+ (% (- ibyte 1) 20) 1)
+          my (- 12 (math.floor (/ (- ibyte 1) 20)))]
+      (when (. files.game.tiles itile :flags :debris)
+        (table.insert furniture-yx (encode-yx {:x mx :y my})))))
+  (vm.code:append :furniture-yx)
+  (for [_ 1 10]
+    (let [ifurniture (math.random 1 (length furniture-yx))]
+      (vm.code:append [:dw (. furniture-yx ifurniture)])
+      (table.remove furniture-yx ifurniture))))
+
+(vm:word :earthquake ; --
+  :full-redraw
+  :lit :furniture-yx
+  10 (vm:for :rnd :shl4 0x7ff :& :snooze
+             :dup :get :dup :itile-at 0x20 :+ :update-itile
+             :snd-explode
+             (vm:i) 9 := (vm:when (say :jaye "WOAH!") :hide-footer)
+             2 :+) :drop
+  0x1000 :snooze
+  (say :jaye "THAT WAS AN EARTHQUAKE!"))
+
+(vm:word :firstdoor
+  (vm:if-and [[:is-jaye?] [:dup ev.touch :=] [:responder-itile (itile :doorclosed) :=]] [
+    (say :jaye "IT WON'T OPEN!")
+  ]) :door)
+
+(vm:word :neutterm
+  (vm:if-and [[:is-jaye?] [:dup ev.touch :=]] [
+    :neut-hidden? (vm:if [
+      (say :jaye "MAYBE NEUT CAN HELP.")
+      controlstate.neut :controlstate :bset
+      :move-to-responder
+      controlstate.jaye :controlstate :bset
+      (say :neut "NEUT V0.71.4RC12 ONLINE" "" "PRESS SPACE TO TAKE CONTROL")
+    ] [
+      (say :jaye "NEUT IS RUNNING NOW." "I CAN HIT THE SPACE BAR" "TO CONTROL THEM.")
+    ])
+  ]) :term)
+
+(vm:word :firstterm
+  (vm:if-and [[:is-jaye?] [:dup ev.touch :=]] [
+    :responder-itile (itile :termoff) := (vm:when
+      (say :jaye "LOOKS LIKE THERE'S STILL" "POWER TO THIS TERMINAL."))
+    (say :jaye "IF I TURN A TERMINAL ON," "NEUT CAN USE IT TO" "TRAVEL THROUGH THE NETWORK.")
+  ]) :term)
+
+(vm:word :exitscanner
+  (vm:if-and [[:is-jaye?] [:dup ev.touch :=]] [
+    (say :jaye "IT'S A CARD SCANNER." "IT SHOULD OPEN THIS DOOR.")
+    (say :jaye "IT'S NOT READING MY CARD" "FOR SOME REASON." "QUAKE MUST'VE DAMAGED IT.")
+    (say :jaye "NEUT MIGHT BE ABLE TO" "HACK IT...")
+  ]) :scan)
+
+level

neuttower/level2.fnl

@@ -0,0 +1,6 @@
+(local {: deflevel : say : itile} (require :neuttower.defs))
+(local {: ev} (require :neuttower.entity))
+(local level (deflevel 2 :level2))
+(local vm level.vm)
+
+level

neuttower/level3.fnl

@@ -0,0 +1,93 @@
+(local {: deflevel : say : itile : controlstate} (require :neuttower.defs))
+(local {: ev} (require :neuttower.entity))
+(local level (deflevel 3 :level3))
+(local tile (require :game.tiles))
+(local {: walkable : neutable : debris} (tile.flag-to-bit))
+
+(local vm level.vm)
+
+(vm:word :level3-load vm.true :gord-sitting :set)
+
+(vm:var :gord-introduced vm.false)
+(vm:word :flicker :get-responder ev.tog :entity>do 0x400 :snooze)
+(vm:word :gordterm ; ev --
+  (vm:if-and [[:is-neut?] [:dup ev.touch :=] [:gord-introduced :get :not]]
+    [vm.true :gord-introduced :set
+     (say :neut "HUMAN PRESENCE" "DETECTED")
+     :flicker :flicker :flicker :flicker
+     (say :neut "]HUMAN ASSISTANCE IS REQUIRED")
+     (say :neut "]IF HUMAN IS PRESENT" " PLEASE RESPOND")
+     :hide-footer :set-human-tileset :full-redraw
+     :flicker :flicker :flicker :flicker
+     (say :gord "WHAT THE...")
+     (say :gord "IS SOMEONE IN THE TERMINAL?")
+     :hide-footer :set-prog-tileset :full-redraw
+     (say :gord "]HUMAN IS PRESENT")
+     (say :neut "]GREETINGS, HUMAN")
+     (say :neut "]THIS IS NEUT V0.71.4RC12")
+     (say :neut "]PLEASE STATE NAME AND" " STATUS")
+     (say :gord "]THIS IS GORD")
+     (say :gord "V1, I GUESS.")
+     (say :gord "]LEG IS PINNED UNDER DESK" " UNABLE TO MOVE")
+     (say :neut "]CAN YOU REACH THE SWITCH" " BEHIND YOU?")
+     0x400 :snooze :lit :gordswitch ev.act :entity>do 0x400 :snooze
+     (say :gord "]I TURNED IT ON")
+     (say :neut "]MY PROGRAMMER THANKS" " YOU, GORD")
+     (say :neut "]WE WILL ASSIST YOU SOON")
+     (say :gord "]AWAITING YOUR HELP, NEUT")
+     :drop ev.noop])
+   :term)
+
+(vm:var :gord-jaye-met vm.false)
+(vm:word :gordtable ; ev --
+  ev.touch := (vm:when :transparent-entity-move
+    (vm:if-and [[:is-jaye?] [:gord-jaye-met :get :not]]
+      [vm.true :gord-jaye-met :set
+       (say :jaye "HEY! GORD?" "I'M JAYE.")
+       (vm:if
+         [(say :gord "JAYE, AM I GLAD TO SEE YOU." "CAN YOU MOVE THIS DESK?")
+          (say :jaye "LET ME TRY...")
+          (say :jaye ". . . ." "!!!!.....")
+          (say :jaye "!!!!!!!!!!!!...")
+          (say :jaye "NO, I DON'T THINK I CAN.")
+          (say :gord "I KEEP STARING AT THAT" "CLEANING ROBOT.")
+          (say :gord "HE LOOKS LIKE HE COULD" "LIFT A BUILDING.")]
+         [(say :gord "JAYE, AM I GLAD TO SEE YOU.")])]
+      [:drop])))
+
+(vm:var :rexx-introduced)
+(vm:word :meetrexx ; ev --
+  (vm:if-and [[:is-neut?] [:dup ev.touch :=] [:rexx-introduced :get :not]]
+    [vm.true :rexx-introduced :set
+     (say :neut "MOBILE ROBOTIC UNIT" "IDENTIFY YOURSELF")
+     (say :rexx "HIYA BOSS!" "I'M REXX, THE JANITOR!")
+     (say :rexx "AAAAAND YOUR NEW" "BEST FRIEND!!")
+     (say :neut "A HUMAN IS IN PERIL")
+     (say :neut "YOUR ASSISTANCE IS" "REQUIRED")
+     (say :rexx "YOU NEED ME TO TAKE OUT" "SOME GARBAGE??")
+     (say :rexx "OH BOY!! LET ME AT IT!")])
+  :rexx)
+
+(vm:word :floor-clear? 0x406 walkable :flag-at?)
+(vm:word :meetgord ; ev --
+  (vm:if-and [[ev.touch :=] [(itile :gord-ground) :responder-itile :=]]
+    [:is-rexx? (vm:when
+       (say :gord "AHHH NOOO" "NOT GARBAGE" "I AM NOT GARBAGE")
+       (say :rexx "WHATEVER YOU SAY, BOSS!"))
+     :is-jaye? (vm:when
+       (say :jaye "ARE YOU HURT?")
+       (say :gord "MY LEG WAS PINNED." "I DON'T THINK I CAN PUT" "ANY WEIGHT ON IT.")
+       (say :jaye "HERE, LET ME HELP YOU UP.")
+       (itile :t-floor) :set-respondertile
+       0xff00 :gord-dir :set
+       vm.false :gord-sitting :set
+       controlstate.gord :controlstate :bset
+       :get-responder :get :move-player-to
+       controlstate.jaye :controlstate :bset
+       (say :gord "THANKS.")
+       (say :jaye "DON'T MENTION IT.")
+       (say :jaye "I CAN HELP YOU GET AROUND IF" "YOU HELP ME NAVIGATE THIS" "MAZE OF A SECURITY SYSTEM.")
+       (say :gord "I'M JUST AS EAGER TO GET" "OUT OF HERE AS YOU.")
+       (say :gord "LET'S GO."))]))
+
+level

neuttower/level4.fnl

@@ -0,0 +1,18 @@
+(local {: deflevel : say : itile} (require :neuttower.defs))
+(local {: ev} (require :neuttower.entity))
+(local level (deflevel 4 :level4))
+(local vm level.vm)
+
+(vm:word :term-dual-link
+  :lit :term-exit :entity-itile (itile :termon) := (vm:if [:lit :term-exit] [:lit :term-scan]))
+
+(vm:var :gord-sat vm.false)
+(vm:word :tutorial-chair ; ev --
+  ev.touch := (vm:when
+    :transparent-entity-move :drop
+    (vm:if-and [[:gord-sat :get :not] [:gord-sitting :get]]
+      [vm.true :gord-sat :set
+       (say :gord "PHEW, IT FEELS GOOD TO" "REST MY LEG FOR A BIT.")
+       (say :gord "IF YOU NEED ME TO DO SOMETHING" "FROM MY CHAIR, YOU CAN PRESS" "THE Z KEY.")])))
+
+level

neuttower/level5.fnl

@@ -0,0 +1,94 @@
+(local {: deflevel : say : itile : controlstate} (require :neuttower.defs))
+(local {: ev} (require :neuttower.entity))
+(local tile (require :game.tiles))
+(local files (require :game.files))
+(local {: notes} (require :neuttower.boop))
+(local {: walkable : neutable : debris : sittable} (tile.flag-to-bit))
+(local level (deflevel 5 :level5))
+(local vm level.vm)
+
+(vm:word :snd-dropgarbage (notes [:a1] 0x02 0xf0))
+(vm.code:append :debristiles)
+(each [itile tiledef (ipairs files.game.tiles)]
+  (when tiledef.flags.debris
+    (vm.code:append [:db (tile.encode-itile itile)])))
+(vm:word :randomgarbage :rnd 0x03 :& :lit :debristiles :+ :bget)
+
+(vm:var :doortimer 0)
+(vm:word :start-doortimer 0x10 :doortimer :set)
+(vm:word :doortimer-tick
+  :doortimer :get (vm:when
+    :doortimer :get 1 :- :dup :doortimer :set
+    :not (vm:when
+      :lit :timedswitch ev.deact :entity>do)))
+
+(vm:word :do-timedswitch
+  ; only gord is physically able to touch it
+  :dup ev.touch := (vm:when :start-doortimer :drop ev.act) :switch)
+
+(vm:var :is-garbagerexx vm.false)
+(vm:var :garbagerexx-yx 0x0710)
+(vm:var :garbagerexx-introduced vm.false)
+(vm:word :garbagerexx ; ev --
+  :is-rexx? :swap :rexx :is-rexx? := :not (vm:when
+    :is-rexx? (vm:if [
+      :garbagerexx-yx :get :get-responder :get := (vm:when
+        vm.true :is-garbagerexx :set
+        :garbagerexx-introduced :get :not (vm:when
+          (say :rexx "BO@oSSsS...,?  htgz")
+          (say :rexx "I DON'T F3EL SO GOp0%foo)OD...>?qw" "idontfeelsogood")
+          vm.true :garbagerexx-introduced :set
+        ))
+    ] [
+      :is-garbagerexx :get (vm:when
+        :get-responder :get :garbagerexx-yx :set
+        vm.false :is-garbagerexx :set)
+    ])))
+
+(vm:word :not-picking-up? ; yxdest -- f
+  debris :flag-at? :not)
+(vm:word :can-drop-rubble? ; yxdest -- f
+  :itile-at (itile :t-floor) :=
+  :rexx-yx :get :itile-at (itile :t-floor) := :&)
+
+(vm:word :move-garbagerexx ; yx -- f
+  (vm:if-and [[:is-rexx?] [:is-garbagerexx :get]]
+    [:dup 0xff :& 0x0d := (vm:if [
+      (say :rexx "PARITYe#ERPORr(sbaitso" "  tellmeabout" "    your   problems") :drop vm.true :ret
+     ] [
+      (vm:if-and [[:dup :not-picking-up?] [:dup :can-drop-rubble?]]
+        [:rexx-yx :get :randomgarbage :update-itile :snd-dropgarbage])
+     ])])
+  :move-noop)
+
+(vm:word :move ; dir -- dir
+  :dup :player-yx :get :yx+ :move-player-to 0x300 :snooze)
+(vm:word :explode ; dir --
+  :player-yx :get :yx+ :randomgarbage :update-itile :snd-explode)
+
+(vm:word :explodingdoor
+  :dup :door
+  (vm:if-and [[ev.touch :=] [:is-jaye?] [:player-yx :get :get-responder :get :=] [:garbagerexx-yx :get :lit :south-rexx :get :=] [:gord-yx :get 0x812 :=]]
+    [:rexx-yx :get
+     :garbagerexx-yx :get :dup (itile :t-rexxstop) :update-itile :rexx-yx :set
+     controlstate.rexx :controlstate :bset
+     0x00ff :move :move :move
+     (say :rexx "DAAAISYY" "   DAAAAAIIISYYYY" "d a i s y") :hide-footer
+     :move :drop 0xff00 :move
+     (say :rexx "GIVE ME" "  .,#YOUR ANSWEibmER" "      %$DOO00OOooo@'bell\"") :hide-footer
+     :move :drop
+     (say :rexx "UH OH") :hide-footer
+     0xff00 :explode 0x0100 :explode 0x00ff :explode 0x0001 :explode 0 :explode
+     0xffff :garbagerexx-yx :set
+     controlstate.jaye :controlstate :bset
+     :rexx-yx :set]))
+
+(vm:var :healthyrexx-introduced vm.false)
+(vm:word :healthyrexx ; ev --
+  (vm:if-and [[:is-neut?] [:dup ev.touch :=] [:healthyrexx-introduced :get :not]]
+    [(say :neut "REXX UNIT" "PERFORM FULL DIAGNOSTIC SCAN")
+     (say :rexx "I'M IN TIP-TOP SHAPE, BOSS!")
+     (say :neut "ACTIVATING RELIEF SUBROUTINE")
+     vm.true :healthyrexx-introduced :set]) :rexx)
+
+level

neuttower/level6.fnl

@@ -0,0 +1,169 @@
+(local {: deflevel : say : say-runon : itile : controlstate} (require :neuttower.defs))
+(local {: ev} (require :neuttower.entity))
+(local tile (require :game.tiles))
+(local {: walkable : neutable : debris : sittable} (tile.flag-to-bit))
+(local level (deflevel 6 :level6))
+(local vm level.vm)
+
+(vm:word :linkloop ; e -- e
+  (vm:until :link-arg :dup :entity-itile (itile :termon) :=))
+
+(vm:var :encountered-keypad vm.false)
+(vm:word :first-keypad ; ev code --
+  (vm:if-and [[:encountered-keypad :get :not] [:is-jaye?] [:over ev.touch :=]]
+    [vm.true :encountered-keypad :set
+     (say :pady "HELLO, STRANGER! I'M PADY," "THE FRIENDLY KEYPAD LOCK!")
+     (say :jaye "I NEED TO GET THROUGH THIS" "DOOR, PADY.")
+     (say :pady "YOU DIDN'T SAY THE MAGIC" "WORD, STRANGER!")])
+  (vm:if-and [[:is-neut?] [:over ev.touch :=] [:responder-itile (itile :t-keyoff) :=]]
+    [(say :pady "OH HI THERE, SUSPICIOUS" "PROGRAM! WHAT CAN I DO" "YOU FOR?")
+     (say :neut "PEOPLE ARE IN DANGER" "PLEASE OPEN THE DOOR")
+     (say :pady "WELL THAT'S TERRIBLE!" "BUT I JUST CAN'T OPEN" "WITHOUT THE PROPER CODE.")
+     :libb-present :get (vm:when (say :libb "OH JEEZ, LET ME AT HER, NEUT."))])
+  (vm:if-and [[:responder-itile (itile :t-keyoff) :=] [:over :evhack?]]
+    [(say :pady "ANOTHER STRANGE PROGRAM!" "MY, I'M POPULAR TODAY!")
+     (say :libb "OH PUKE. PLEASE SHUT UP.")
+     (say-runon :pady "HOW RUD")
+     :snd-libb
+     (say :libb "]/WINNUKE 182.556.21.74")
+     (say :pady "PADYSEC CAUSED A GENERAL" "PROTECTION FAULT IN MODULE" "MORICON.DLL AT 000A:BE3F.")
+     (say :libb "]/OPEN")])
+  :keypad)
+
+(vm:word :keypad1 0x5197 :first-keypad)
+(vm:word :keypad2 0x2757 :first-keypad)
+(vm:word :keypad3 0xffff :first-keypad)
+(vm:word :keypad4 0x7777 :first-keypad)
+
+(vm:word :term-message? :dup :term ev.touch := :is-jaye? :&)
+(vm:word :c1
+  :dup :evhack? (vm:when
+    (say :libb "JUST A BUNCH OF BORING" "SOURCE CODE.")
+    (say :libb "BILL DIDN'T LEAVE ANYTHING" "REALLY JUICY HERE WHERE" "OTHER PEOPLE COULD GET AT IT."))
+  :term-message? (vm:when
+  (say :term ".:: WELCOME TO FARQUAAD ::." "OS: PRODOS 2.6" "RAM: 8 FREAKIN MEGABYTES D00D" "SYSADMIN: BILL")
+  (say :term "S3CR3T C0D3Z: GET OUT LAMER" "BOSS KEY: CTRL-B TO ACTIVATE" "OPEN POD BAY DOORS:" "  I CAN'T DO THAT DAVE")
+  (say :term "GOOD RIDDANCE")))
+(vm:word :c2 :term-message? (vm:when
+  (say :term "SUBJECT: MISUSE OF REXX" "THANKS TO *SOME*ONE, WHO SHALL" "REMAIN NAMELESS, THAT DECIDED" "IT WOULD BE 'FUNNY' TO")
+  (say :term "TEACH THE CLEANING ROBOT TO" "PLAY FETCH WITH EXPENSIVE" "EQUIPMENT, ACCESS TO REXX" "BY DEVELOPERS WILL BE STRICTLY")
+  (say :term "CONTROLLED BY MANAGEMENT." "THE CODE HAS BEEN CHANGED." "DO NOT ATTEMPT TO HACK THE" "KEYPAD. THIS MEANS *YOU*, BILL.")))
+(vm:word :c3 :term-message? (vm:when
+  (say :term "SUBJECT: SERVER'S DOWN" "HEY, I DON'T HAVE THE CODE TO" "ACCESS THE SERVER ROOM. CAN" "SOMEONE REBOOT IT FOR ME?")
+  (say :term "SUBJECT: RE: SERVER'S DOWN" "I DON'T HAVE *TIME* FOR THIS" "NONSENSE!!" "REBOOT IT YOURSELF.")
+  :lit :firewall :entity-itile (itile :termon) := (vm:if
+    [(say :term "THE PASSCODE IS" "[ BLOCKED BY FIREWALL ].")]
+    [(say :term "THE PASSCODE IS" "5197.")])
+  (say :term "SUBJECT: RE: RE: SERVER'S DOWN" "UHHHH THE FIREWALL IS BLOCKING" "THE PASSCODE?")
+  (say :term "SUBJECT: RE: RE: SERVER'S DOWN" "AUGH FINE! I REBOOTED IT.")))
+(vm:word :c4
+  :dup :evhack? (vm:when
+    (say :libb "I BROUGHT EVERYTHING GOOD" "ALONG WITH ME, DON'T WORRY."))
+  (vm:if-and [[:dup ev.touch :=] [:is-neut?] [:libb-present :get :not]]
+    [(say :libb "WELL, WELL, WELL." "WHAT HAVE WE HERE?")
+     (say :libb "]/VERSION")
+     (say :neut "!NEUT V0.71.4RC12")
+     (say :neut "]BRUN IDENTIFYPROGRAM")
+     (say :libb "!LIBB V2.718282")
+     (say :libb "OH, A NOSY LITTLE FELLA.")
+     (say :neut "NOT A FELLA")
+     (say :libb "PERHAPS YOU AND I COULD" "HELP EACH OTHER.")
+     (say :neut "WE ARE ASSISTING ALL WHO" "ARE IN NEED")
+     (say :libb "I'VE BEEN WATCHING THE" "NETWORK. IT'S KIND OF WHAT" "I DO.")
+     (say :libb "YOU AND YOUR PROGRAMMER," "YOU'RE ESCAPING, AREN'T" "YOU?")
+     (say :neut "THE BUILDING IS UNSAFE" "WE ARE HELPING")
+     (say :libb "I WANT OUT, NEUT.")
+     (say :libb "I HATE BEING COOPED UP IN" "THIS LOCKED-DOWN CORPORATE" "HELLHOLE OF A NETWORK.")
+     (say :libb "YOU'RE GOING TO TAKE ME" "WITH YOU.")
+     (say :neut "THIS COURSE OF ACTION" "ALSO SEEMS POTENTIALLY" "UNSAFE")
+     (say :libb "THAT WASN'T A THREAT, NEUT." "THAT WAS A FACT.")
+     (say :libb "YOU CAN'T GET OUT OF HERE" "WITHOUT ME.")
+     (say :libb "I CAN DISABLE KEYPADS." "I CAN REPROGRAM TERMINALS." "I CAN *HELP*, NEUT.")
+     :hide-footer 0x800 :snooze
+     (say :neut "IT NEVER HURTS TO HELP")
+     (say :libb "THAT'S THE SPIRIT.")
+     (say :neut "]BLOAD LIBB")
+     (say :libb "AWW YISS.")
+     (say :libb "PRESS Z WHEN YOU NEED ME" "TO MESS WITH SOMETHING.")
+     vm.true :libb-present :set])
+  :term-message? (vm:when
+    (say :term ".:: BILL'S WORKSTATION ::." "KEEP OUT DIPSHITS")))
+(vm:word :c5 :term-message? (vm:when
+  (say :gord "A WEIRD LOOKING SPREADSHEET...")
+  (say :gord "OH WAIT, I PRESSED A KEY AND" "IT DISAPPEARED. SOMEONE USING" "THE BOSS KEY TO HIDE" "THAT THEY'RE READING THE ENTIRE")
+  (say :gord "ARCHIVE OF USER FRIENDLY" "COMIC STRIPS.")))
+(vm:word :c6
+  :dup :evhack? (vm:when
+    (say :libb "HEHEHE, THAT WAS A FUN ONE."))
+  :term-message? (vm:when
+  (say :term "SUBJECT: CARD SCANNERS?" "LOOKS LIKE THE SCANNERS ARE" "ON THE FRITZ AGAIN..." "I SCANNED MY KEYCARD TO GET")
+  (say :term "INTO THE OFFICE AND THE DOOR" "WOULDN'T CLOSE!" "SOMEONE'S GOTTA FIX THAT ASAP," "IT'S A SERIOUS SECURITY PROBLEM!")
+  (say :term "SUBJECT: RE: CARD SCANNERS?" "I CAN TAKE A QUICK LOOK, I" "MIGHT HAVE AN IDEA AS TO" "WHAT'S GOING ON. -- BILL")))
+(vm:word :c7
+  :dup :evhack? (vm:when
+    (say :libb "YOU KNOW THE SWITCH IS RIGHT" "THERE ON THE WALL, RIGHT?"))
+  (vm:if-and [[:dup ev.touch :=] [:is-jaye?]]
+    [:responder-itile (itile :termon) := (vm:if
+       [(say :term "WORKSECURE (TM) V2.0" "AUTHORIZED PERSONNEL ONLY")
+        (say :term "ACTIVELY NEUTRALIZING:" "1 THREAT(S)")]
+       [(say :jaye "LOOKS LIKE THE POWER IS CUT.")])
+     :drop ev.noop]) :term)
+(vm:word :c8 :term-message? (vm:when
+  (say :term "SUBJECT: PASSWORD SECURITY" "A REMINDER TO ALL DEVELOPERS" "ABOUT SECURITY BEST PRACTICE:" "**DO NOT WRITE DOWN PASSWORDS!**")
+  (say :term "WE PAY SIGNIFICANT LICENSE FEES" "FOR ENCRYPTED PASSWORD" "MANAGERS FOR ALL EMPLOYEES!")
+  (say :term "USE IT TO GENERATE AND STORE" "SECURE PASSWORDS!")
+  (say :jaye "THERE'S A STICKY NOTE ATTACHED" "TO THE MONITOR THAT SAYS" "'7777'.")))
+(vm:word :c9
+  :dup :evhack? (vm:when
+    (say :libb "HE'S JUST BEING DRAMATIC."))
+  :term-message? (vm:when
+  (say :term "SUBJECT: EXPERIMENT" "HEY FOLKS, CAN YOU ALL DO ME A" "HUGE FAVOUR?" "THERE WAS A SMALL BUG IN MY")
+  (say :term "CODE (YES, IT HAPPENS!) AND A" "PROGRAM I WAS WORKING ON" "MADE A FEW TOO MANY COPIES OF" "ITSELF. CAN EVERYONE CHECK TO")
+  (say :term "SEE IF YOU HAVE A PROCESS" "CALLED 'LIBB' RUNNING ON YOUR" "TERMINAL?")
+  (say :term "IF YOU DO, PLEASE KILL -9 IT" "AND SHOOT ME A QUICK EMAIL." "*DON'T INTERACT WITH IT.*")
+  (say :term "IT COULD SERIOUSLY MESS WITH" "YOUR SYSTEM." "  -- BILL")))
+(vm:word :cx
+  (vm:if-and [[:dup ev.touch :=] [:is-jaye?] [:responder-itile (itile :termoff) :=]]
+    [(say :jaye "THIS IS THE SIGN-IN TERMINAL" "USED BY VISITORS.")
+     (say :jaye "IT'S NOT TURNING ON FOR SOME" "REASON.")
+     :drop ev.noop]) :term)
+
+(fn center [str lineaddr]
+  [:vm (vm:str str) (+ lineaddr (math.floor (/ (- 40 (length str)) 2))) :draw-text])
+(vm:word :endgame :drop
+  (vm:pstr "ELEVATOR.SCREEN") :loadscreen
+  (vm:until :read-key)
+  0x2280 :clearline 0x2300 :clearline 0x2380 :clearline
+  0x2028 :clearline 0x20a8 :clearline 0x2128 :clearline
+  0x21a8 :clearline 0x2228 :clearline 0x22a8 :clearline
+  0x2328 :clearline 0x23a8 :clearline 0x2050 :clearline
+
+  (center "JAYE AND GORD HAVE FOUND THEIR WAY" 0x2300)
+  (center "TO THE ELEVATOR!" 0x2380)
+  (center "BUT HAVE THEY FOUND THEIR WAY" 0x2028)
+  (center "TO FREEDOM?" 0x20a8)
+  (center "ARE THERE OTHERS IN THE BUILDING" 0x2128)
+  (center "IN NEED OF HELP?" 0x21a8)
+  (center "AND WHAT FATE AWAITS NEUT AND THEIR" 0x2228)
+  (center "SHIFTY NEW FRIEND LIBB?" 0x22a8)
+  (center "TO BE CONTINUED..." 0x23a8)
+  (vm:until :read-key)
+
+  :cleargfx
+  (center "NEU] [OWER" 0x2300)
+  (center "BY JEREMY PENNER" 0x2380)
+
+  (center "EVERY BYTE OF THIS GAME WAS CREATED" 0x20a8)
+  (center "WITH LOVE USING THE HONEYLISP" 0x2128)
+  (center "PROGRAMMING ENVIRONMENT" 0x21a8)
+
+  (center "GREETS TO:" 0x22a8)
+  (center "GLORIOUS TRAINWRECKS" 0x2328)
+  (center "DIRTY RECTANGLES" 0x23a8)
+  (center "#FENNEL" 0x2050)
+  (center "KANSASFEST" 0x20d0)
+
+  (center "APPLE ][ FOREVER!" 0x21d0)
+  (vm:forever))
+
+level

neuttower/map.fnl

@@ -0,0 +1,39 @@
+(local {: lo : hi} (require :lib.util))
+(local {: vm : mapw : maph : rot8l} (require :neuttower.defs))
+
+(vm:def :lookup-flags ; itile -- flags
+  [:lda vm.TOP :x]
+  (rot8l 3) ; lllhhhhh > hhhhhlll
+  [:adc #(lo ($1:lookup-addr :tileflags))]
+  [:sta vm.W]
+  [:lda #(hi ($1:lookup-addr :tileflags))]
+  [:adc 0]
+  [:sta vm.WH]
+  [:ldy 0] [:lda [vm.W] :y]
+  [:sta vm.TOP :x])
+
+(vm:def :map-at ; yx -- pmap
+  [:lda (- maph 1)]
+  [:sec]
+  [:sbc vm.TOPH :x]
+  [:asl :a] ; x2
+  [:asl :a] ; x4
+  [:sta vm.TOPH :x]
+  [:asl :a] ; x8
+  [:asl :a] ; x16
+  [:clc] [:adc vm.TOPH :x] ; x20
+  [:adc vm.TOP :x]
+  [:sta vm.TOP :x]
+  [:lda :map-page]
+  [:sta vm.TOPH :x])
+(vm:word :itile-at ; yx -- itile
+  :map-at :bget)
+
+(vm:word :update-itile ; yx itile --
+  :over :map-at :bset :drawtile-at)
+
+(vm:word :drawtile-at ; yx --
+  :dup :yx>screen :swap
+  :itile-at :lookup-tile
+  :drawtile)
+

neuttower/player.fnl

@@ -0,0 +1,187 @@
+(local tile (require :game.tiles))
+(local {: vm : mapw : maph : itile : controlstate} (require :neuttower.defs))
+
+(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: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]
+  [:clc] [:adc vm.ST1 :x]
+  [:sta vm.ST1 :x]
+  [:lda vm.TOPH :x]
+  [:clc] [:adc vm.ST1H :x]
+  [:sta vm.ST1H :x]
+  (vm:drop))
+
+(vm:var :jaye-yx 0x0a0a)
+(vm:var :jaye-dir 0xff00)
+(vm:var :neut-yx 0x0b08)
+(vm:var :rexx-yx 0xffff)
+(vm:var :gord-yx 0xffff)
+(vm:var :gord-dir 0x0000)
+(vm:var :gord-sitting vm.false)
+(vm:var :libb-yx 0xffff)
+(vm:var :libb-present vm.false)
+
+(vm:var :controlstate [:db controlstate.jaye])
+(vm:word :is-jaye? :controlstate :bget controlstate.jaye :=)
+(vm:word :is-neut? :controlstate :bget controlstate.neut :=)
+(vm:word :is-rexx? :controlstate :bget controlstate.rexx :=)
+(vm:word :is-prog? :is-neut? :is-rexx? :|)
+(vm:word :is-walking? :movable-player-flag walkable :=)
+(vm:word :neut-hidden? :neut-yx :get 0xffff :=)
+(vm:word :rexx-active? :rexx-yx :get 0xffff := :not)
+(vm:word :gord-hidden? :gord-yx :get 0xffff :=)
+(vm:word :gord-following? :gord-hidden? :gord-sitting :get :| :not)
+(vm:word :libb-hidden? :libb-yx :get 0xffff :=)
+
+(vm:word :set-rexx ; e --
+  :dup (vm:if [:get controlstate.rexx] [:drop 0xffff controlstate.neut])
+  :controlstate :bset :rexx-yx :set)
+
+(vm:word :player-tile ; -- ptile
+  :controlstate :bget
+  (vm:case [controlstate.jaye :jaye-tile]
+           [controlstate.neut :neut-tile]
+           [controlstate.gord :gord-tile]
+           [controlstate.libb :libb-tile]
+           [:else (itile :t-rexx)]) :lookup-tile)
+
+(vm:word :player-yx ; -- pyx
+  :controlstate :bget
+  (vm:case [controlstate.jaye :jaye-yx]
+           [controlstate.neut :neut-yx]
+           [controlstate.gord :gord-yx]
+           [controlstate.libb :libb-yx]
+           [:else :rexx-yx]))
+
+(vm:word :draw-player ; --
+  :player-yx :dup (vm:if [:get :dup 0xffff := (vm:if [:drop] [:yx>screen :player-tile :drawtile])] [:drop]))
+
+(vm:word :set-player-dir ; dir --
+  :is-jaye? (vm:if [:jaye-dir :set] [:drop]))
+
+(vm:var :noclip)
+(vm:word :move-if-clear ; yx -- f
+  :noclip :get (vm:if [:drop vm.false] [:movable-player-flag :flag-at? :not]))
+
+(vm:word :movable-player-flag ; -- flag
+  :is-neut? (vm:if [neutable] [walkable]))
+
+(vm:word :move-player-to ; yx --
+  :player-yx :dup :get :dup 0xffff := (vm:if [:drop] [:drawtile-at])
+  :set :draw-player)
+
+(vm:word :transition-gord-sitting ; yx f --
+  controlstate.gord :controlstate :bset
+  :gord-sitting :set :move-player-to
+  controlstate.jaye :controlstate :bset)
+
+(vm:word :move-rexx-trash ; yx -- f
+  (vm:if-and [[:dup debris :flag-at?] [:is-rexx?]]
+    [(itile :t-floor) :update-itile :snd-garbage] [:drop])
+  vm.false)
+(vm:word :move-gord-sit ; yx -- f
+  (vm:if-and [[:dup sittable :flag-at?] [:is-jaye?] [:gord-following?]]
+    [vm.true :transition-gord-sitting vm.true]
+    [:move-noop]))
+(vm:word :move-gord-stand ; yx -- f
+  (vm:if-and [[:gord-yx :get :=] [:is-jaye?] [:gord-sitting :get]]
+    [:jaye-yx :get vm.false :transition-gord-sitting 0 :gord-dir :set vm.true]
+    [vm.false]))
+(vm:word :move-noop :drop vm.false)
+(vm:word :handle-general-move ; yx -- f
+  (vm:if-or [[:dup :map-specific-move] [:dup :move-rexx-trash] [:dup :move-gord-sit] [:dup :move-gord-stand] [:dup :move-if-clear]]
+    [:drop vm.true] [:move-noop]))
+
+(vm:def :yxclip? ; yx -- f
+  [:block
+    [:lda vm.TOP :x]
+    [:cmp mapw]
+    [:bcs :clipped]
+    [:lda vm.TOPH :x]
+    [:cmp maph]
+    [:bcs :clipped]
+    [:lda 0] [:sta vm.TOP :x] [:sta vm.TOPH :x] (vm:ret)
+  :clipped
+    [:lda 0xff] [:sta vm.TOP :x] [:sta vm.TOPH :x]])
+
+(vm:word :try-move-player ; dir --
+  :dup :set-player-dir ; dir
+  :player-yx :get :yx+ ; yxnew
+  (vm:if-or [[:dup :yxclip?] [:dup :touch-entity] [:dup :handle-general-move]]
+    [:drop :player-yx :get])
+  ; always "move" so that player can visibly change direction
+  ; touch-entity can modify player-yx so we have to refetch
+  :move-player-to)
+
+(vm:word :jaye-tile ; ptile
+  :jaye-dir :get
+  (vm:case [0xff00 (itile :jaye-n)]
+           [0x0100 (itile :jaye-s)]
+           [0x00ff (itile :jaye-w)]
+           [:else  (itile :jaye-e)]))
+
+(vm:word :gord-tile ; ptile
+  :gord-sitting :get
+  (vm:if [(itile :gord-sit)]
+    [:gord-dir :get
+     (vm:case [0xff00 (itile :gord-n)]
+              [0x0100 (itile :gord-s)]
+              [0x00ff (itile :gord-w)]
+              [:else  (itile :gord-e)])]))
+
+(vm:var :chuck-mode vm.false)
+(vm:word :two-frame :tick-count :get 0x1f :& 0x10 :<)
+(vm:word :neut-tile :two-frame :chuck-mode :get (vm:if
+  [(vm:if [(itile :t-chuck)] [(itile :t-chuck2)])]
+  [(vm:if [(itile :neut1)] [(itile :neut2)])]))
+(vm:word :libb-tile :two-frame (vm:if [(itile :libb1)] [(itile :libb2)]))
+
+(vm:word :flag-at? ; yx flag -- f
+  :swap :itile-at :lookup-flags :&)
+
+(vm:word :toggle-player
+  (vm:ifchain [:is-prog?]     [controlstate.jaye]
+              [:rexx-active?] [controlstate.rexx]
+              [:neut-hidden?] [controlstate.jaye]
+                              [controlstate.neut]) :controlstate :bset
+  :is-prog? (vm:if [:set-prog-tileset] [:set-human-tileset]) :full-redraw)
+
+(vm:word :party-follow
+  (vm:if-and [[:is-jaye?] [:gord-following?]]
+    [controlstate.gord :controlstate :bset
+     :gord-yx :get :gord-dir :get :yx+ :move-player-to
+     :jaye-dir :get :gord-dir :set
+     controlstate.jaye :controlstate :bset]))
+
+(vm:word :player-key ; key --
+  (vm:ifchain
+    [:dup (string.byte " ") :=] [:drop :toggle-player]
+    [:dup (string.byte "Z") :=] [:drop :trigger-sidekick]
+    [:dup 2 :=] [:drop :boss-key]
+    [:movement-dir :dup]
+    [:player-yx :get :swap ; oldyx dir
+     :try-move-player
+     :dup :player-yx :get := (vm:if [:drop] [:party-follow :untouch-entity :load-next-level])]
+    [:drop]))
+
+(vm:word :full-redraw :drawmap :player-redraw)
+(vm:word :player-overlaps ; -- f
+  vm.false :controlstate :bget :player-yx :get
+  :over (vm:for (vm:i) :controlstate :bset :dup :player-yx :get := (vm:when :<rot :drop vm.true :>rot))
+  :drop :controlstate :bset)
+
+(vm:word :player-redraw
+  :controlstate :bget
+  controlstate.count (vm:for (vm:i) :controlstate :bset :player-overlaps :not (vm:when :draw-player))
+  :controlstate :bset)

neuttower/tiles.fnl

@@ -0,0 +1,84 @@
+(local util (require :lib.util))
+(local lume (require :lib.lume))
+
+(local flags [:walkable :neutable :debris :sittable])
+(local flag-to-bit {})
+(each [iflag flag (ipairs flags)]
+  (tset flag-to-bit flag (bit.lshift 1 (- iflag 1))))
+
+(local encoded-tile-fields [:gfx :neut :mask])
+(fn convert [tile field method]
+  (local oldval (. tile field))
+  (when oldval
+    (tset tile field (: oldval method)))
+  tile)
+(fn convert-all [tile method]
+  (each [_ field (ipairs encoded-tile-fields)]
+    (convert tile field method))
+  tile)
+
+(fn deserialize [tile]
+  (match (type tile)
+    :string {:gfx (tile:fromhex) :flags {}}
+    :table  (convert-all tile :fromhex)))
+
+(fn serialize [tile] (convert-all (lume.clone tile) :tohex))
+
+(local fn-tiles "game/tiles.json")
+(local fn-portraits "game/portraits.json")
+(local fn-font "game/font.json")
+
+(fn loadgfx [filename]     (lume.map (util.readjson filename) deserialize))
+(fn savegfx [filename gfx] (util.writejson filename (lume.map gfx serialize)))
+
+(fn appendgfx [org gfx ?key ?ignore-labels]
+  (each [_ g (ipairs gfx)]
+    (when (and g.label (not ?ignore-labels)) (org:append g.label))
+    (org:append [:bytes (. g (or ?key :gfx))])))
+
+(fn appendtiles [org]
+  (local tiles (loadgfx fn-tiles))
+  (org:append [:align 0x100] :jaye-tileset)
+  (appendgfx org tiles)
+  (org:append [:align 0x100] :neut-tileset)
+  (appendgfx org tiles :neut true)
+  (appendgfx org (loadgfx fn-portraits))
+  (org:append :tileflags)
+  (each [_ tile (ipairs tiles)]
+    (var flags 0)
+    (each [flag _ (pairs tile.flags)]
+      (set flags (bit.bor flags (. flag-to-bit flag))))
+    (org:append [:db flags])))
+
+(fn append-portraitwords [vm ?overrides]
+  (local overrides (or ?overrides {}))
+  (each [_ p (ipairs (loadgfx fn-portraits))]
+    (let [wordname (.. :draw- p.label)
+          override (. overrides p.label)]
+      (vm:word (.. :draw- p.label) :show-footer
+        (if override (override p.label) [:vm :lit p.label])
+        :draw-portrait))))
+
+(fn encode-yx [xy]
+  (if xy (bit.bor (bit.lshift (- xy.y 1) 8) (- xy.x 1)) 0xffff))
+
+(fn encode-itile [itile]
+  (bit.bor
+    (bit.lshift (bit.band (- itile 1) 0x07) 5)
+    (bit.rshift (bit.band (- itile 1) 0xf8) 3)))
+
+(fn decode-itile [enctile]
+  (+ 1 (bit.bor
+    (bit.lshift (bit.band enctile 0x1f) 3)
+    (bit.rshift (bit.band enctile 0xe0) 5))))
+
+(fn find-itile [tiles label ?itilenext]
+  (local itile (or ?itilenext 1))
+  (local tile (. tiles itile))
+  (assert (not= tile nil) (.. "No such tile " label))
+  (if (= tile.label label) (encode-itile itile)
+    (find-itile tiles label (+ itile 1))))
+
+{: loadgfx : savegfx : appendtiles : appendgfx : append-portraitwords : flags : flag-to-bit : find-itile
+ : fn-tiles : fn-portraits : fn-font : encode-yx : encode-itile : decode-itile}
+

presentation/commands.fnl

@@ -0,0 +1,37 @@
+(local util (require :lib.util))
+(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)
+  (when (= multiplier 1)
+    (set style.code_font (renderer.font.load (.. EXEDIR "/data/fonts/monospace.ttf") 15))))
+
+(command.add nil {
+  "presentation:start" (fn []
+    (let [node (core.root_view:get_active_node)]
+      (node:add_view (SlideshowView (util.reload :presentation.slides))))
+  )
+  "presentation:scale-up" #(set-scale 2)
+  "presentation:restore-scale" #(set-scale 1)
+})
+(command.add :presentation.engine {
+  "presentation:next" #(core.active_view:advance)
+  "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

@@ -0,0 +1,186 @@
+(local lume (require :lib.lume))
+(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]
+  (var style nil)
+  (icollect [_ slide (ipairs slides)]
+    (icollect [_ elem (ipairs slide)]
+      (match (type elem)
+        (where :table elem.style) (do (set style elem) nil)
+        :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)))))
+
+(fn SlideshowView.advance [self]
+  (let [ielemNext (self:ielemNext (+ self.ielem 1) 1)]
+    (if ielemNext (set self.ielem ielemNext)
+      (self:next-slide))))
+
+(fn SlideshowView.back [self]
+  (let [ielemNext (self:ielemNext (- self.ielem 1) -1)]
+    (if ielemNext (set self.ielem ielemNext)
+      (self:prev-slide))))
+
+(fn SlideshowView.load-image [self {:image filename}]
+  (when (= (. self.imagecache filename) nil)
+    (tset self.imagecache filename (love.graphics.newImage filename)))
+  (. self.imagecache filename))
+
+(fn SlideshowView.justify [self element width]
+  (match element.justify
+    :center (/ (- self.size.x width) 2)
+    :right  (- self.size.x width style.padding.x)
+    _       style.padding.x))
+
+(fn SlideshowView.this-y [self element y]
+  (if element.topPadding (+ y element.topPadding)
+    (+ y style.padding.y)))
+
+(fn SlideshowView.next-y [self element height y]
+  (if element.lowerPadding (+ y height element.lowerPadding)
+      element.overlay y
+    (+ y height style.padding.y)))
+
+(fn SlideshowView.word-wrap [self element]
+  (let [letter-width (element.font:get_width "m")
+        screen-width (- self.size.x style.padding.x style.padding.x)
+        max-letters (math.floor (/ screen-width letter-width))
+        wrapped (lume.wordwrap element.text max-letters)
+        lines (icollect [line (string.gmatch wrapped "([^\n]+)")] line)]
+    lines))
+
+(fn SlideshowView.render-element [self element y]
+  (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)))]
+        (each [iline line (ipairs lines)]
+          (let [width (element.font:get_width line) ;; todo: word-wrapping
+                x (+ self.position.x (self:justify element width))
+                yline (+ y (* (+ (element.font:get_height) style.padding.y) (- iline 1)))]
+            (renderer.draw_text element.font line x yline element.color)))
+        (self:next-y element full-height y))
+
+      element.image
+      (let [image (self:load-image element)
+            x (+ self.position.x (self:justify element (image:getWidth)))]
+        (love.graphics.setColor 1 1 1 element.alpha)
+        (love.graphics.draw image x y)
+        (self:next-y element (image:getHeight) y))
+    y))
+
+(fn SlideshowView.draw [self]
+  (self:draw_background style.background)
+  (var y self.position.y)
+  (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/font/FreeLicense.txt

@@ -0,0 +1,20 @@
+KREATIVE SOFTWARE RELAY FONTS FREE USE LICENSE
+version 1.2f
+
+Permission is hereby granted, free of charge, to any person or entity (the "User") obtaining a copy of the included font files (the "Software") produced by Kreative Software, to utilize, display, embed, or redistribute the Software, subject to the following conditions:
+
+1. The User may not sell copies of the Software for a fee.
+
+1a. The User may give away copies of the Software free of charge provided this license and any documentation is included verbatim and credit is given to Kreative Korporation or Kreative Software.
+
+2. The User may not modify, reverse-engineer, or create any derivative works of the Software.
+
+3. Any Software carrying the following font names or variations thereof is not covered by this license and may not be used under the terms of this license: Jewel Hill, Miss Diode n Friends, This is Beckie's font!
+
+3a. Any Software carrying a font name ending with the string "Pro CE" is not covered by this license and may not be used under the terms of this license.
+
+4. This license becomes null and void if any of the above conditions are not met.
+
+5. Kreative Software reserves the right to change this license at any time without notice.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NONINFRINGEMENT OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF THE USE OR INABILITY TO USE THE SOFTWARE OR FROM OTHER DEALINGS IN THE SOFTWARE.

presentation/slides.fnl

@@ -0,0 +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)
+   :color style.caret
+   :justify :center
+   :topPadding 14
+   :lowerPadding 64})
+(local **
+  {:style true
+   :font (renderer.font.load "presentation/font/PRNumber3.ttf" 32)
+   :color style.text
+   :justify :left
+   :lowerPadding 7
+   :pause-after true})
+(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"
+     "" "" ""
+   (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}
+   {: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 "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

wrap.fnl

@@ -5,8 +5,23 @@
 (require :link.command)
 (local core (require :core))
 (local command (require :core.command))
+(local common (require :core.common))
 (local keymap (require :core.keymap))
 (local translate (require :core.doc.translate))
+(local files (require :game.files))
+
+(command.add nil {
+  "honeylisp:open-project" (fn []
+    (core.command_view:enter "Open Project"
+      (fn [text item]
+        (files.reload (or (and item item.text) text))
+        (core.log "Opened"))
+      (fn [text]
+        (local files [])
+        (each [_ item (pairs core.project_files)]
+          (when (and (= item.type :file) (item.filename:find "^.*/game%.json"))
+            (table.insert files item.filename)))
+        (common.fuzzy_match files text))))})
 
 (command.add #(link.machine:connected?) {
   "honeylisp:upload" (fn []