Fix codegen, implement 8bitsy dialog editor

asm/asm.fnl

@@ -179,7 +179,7 @@
   (fn process-pdat [pdat process default ...]
     (fn complain [ok ...]
       (if ok (values ...)
-          (do (pp pdat) (error (.. process " failed in " pdat.type " near " (or pdat.nearest-symbol "<start of block>") " @" (or pdat.addr "<no address>") " - " ...)))))
+          (do (error (.. process " failed in " pdat.type " near " (or pdat.nearest-symbol "<start of block>") " @" (or pdat.addr "<no address>") " - " ...)))))
     (local processor (. pdat-processor pdat.type process))
     (if processor (complain (pcall #(processor pdat $...) ...)) default))
 
@@ -256,7 +256,6 @@
     (local block-env (make-env block env))
     (var bytes "")
     (each [_ pdat (ipairs block.pdats)]
-      (print pdat.type pdat.addr pdat.nearest-symbol)
       (process-pdat pdat :generate nil block-env)
       (local pdatbytes (process-pdat pdat :bytes pdat.bytes block-env))
       (assert (= (type pdatbytes) :string) (.. "failed to generate bytes: " (fv pdat)))

editor/8bitsy.fnl

@@ -0,0 +1,29 @@
+(local util (require :lib.util))
+(local actions (require :editor.actions))
+(local {: textbox : dropdown } (util.require :editor.imstate))
+(local files (require :game.files))
+(local lume (require :lib.lume))
+(local style (require :core.style))
+
+(actions.register :say
+  (fn [action view x y w i]
+    (let [characters (lume.map files.game.portraits #$1.label)
+          character (or action.character (. characters 1))
+          lines (or action.lines [])
+          (character y) (dropdown view [:say :char i] character characters x (+ y style.padding.y) 300)
+          (line1 y) (textbox view [:say :line1 i] (. lines 1) x (+ y style.padding.y) 300)
+          (line2 y) (textbox view [:say :line2 i] (. lines 2) x y 300)
+          (line3 y) (textbox view [:say :line3 i] (. lines 3) x y 300)
+          (line4 y) (textbox view [:say :line4 i] (. lines 4) x y 300)
+          ]
+      (set action.character character)
+      (util.nested-tset action [:lines 1] line1)
+      (util.nested-tset action [:lines 2] line2)
+      (util.nested-tset action [:lines 3] line3)
+      (util.nested-tset action [:lines 4] line4)
+      y))
+  (fn [action vm]
+    (local {: say} (require :game.defs))
+    (say action.character (table.unpack (lume.map action.lines #($1:upper))))))
+
+{}

editor/actions.fnl

@@ -9,4 +9,11 @@
 
 (defmethod actions.edit :default (fn [action view x y w i] y))
 
+(fn actions.register [key edit generate]
+  (when (= actions.actionlist nil)
+    (set actions.actionlist []))
+  (table.insert actions.actionlist key)
+  (defmethod actions.edit key edit)
+  (defmethod actions.generate key generate))
+
 actions.hot

editor/init.fnl

@@ -9,6 +9,8 @@
 (local keymap (require :core.keymap))
 (local common (require :core.common))
 
+(require :editor.8bitsy)
+
 (let [commands {}]
   (each [_ name (ipairs [:tile :portrait :font :brush :map])]
     (local cls (require (.. "editor." name "edit")))

editor/mapedit.fnl

@@ -104,6 +104,7 @@
 
 (fn MapEditView.draw-map-editor [self x y]
   (love.graphics.setColor 1 1 1 1)
+  (local button-state self.imstate.left)
   (activate self :map x y (* tilew mapw) (* tileh maph))
   (var iobject-over nil)
   (for [my 1 maph]
@@ -130,7 +131,7 @@
       (when (and self.itile (active? self :map) (mouse-inside tilex tiley tilew tileh) (not= itile self.itile))
         (self:set-tile mx my self.itile))
       (when (and (= self.itile nil) (active? self :map) (mouse-inside tilex tiley tilew tileh))
-        (match self.imstate.left
+        (match button-state
           :pressed (set self.iobject-linking iobject)
           :released
           (if (and (not= iobject nil) (= self.iobject-linking iobject))

game/content.fnl

@@ -1,9 +1,4 @@
 ; TODO: Generate from data?
 (local {: vm : say : deflevel} (require :game.defs))
 
-(deflevel "game/map1.json" :map1)
-(vm:word :cat (say :cat "I'M A CAT"))
-(vm:word :fish (say :angryfish "I'M AN ANGRY FISH" "GRRRR"))
-(vm:word :pot (say :player "IT'S A POT.") (say :player "NOTHING UNUSUAL ABOUT IT.") (say :player "JUST AN ORDINARY POT."))
-(vm:word :suspiciouspot (say :player "IT'S A POT.") (say :player "NOTHING UNUSUAL ABOUT IT.") (say :player "JUST AN ORDINARY POT.") (say :player "YEP, NOTHING SPECIAL HERE."))
-
+(deflevel 1 :map1)

game/defs.fnl

@@ -4,7 +4,9 @@
 (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 actions (require :editor.actions))
 
 (local prg (asm.new))
 (local vm (VM.new prg {:org 0xc00}))
@@ -123,7 +125,7 @@
 (fn append-map [map org label]
   (org:append
     [:align 0x100] label
-    [:bytes (map.map:fromhex)]
+    [:bytes map.map]
     [:db (length map.objects)]
     [:dw (tiles.encode-yx map.player)]
     [:jmp (if (= (or map.tickword "") "") :next map.tickword)]
@@ -138,18 +140,27 @@
 (vm:word :map-specific-move :map 246 :+ :execute)
 (vm:word :map-specific-load :map 249 :+ :execute)
 
-(fn deflevel [mapfile label]
+(fn generate-entity-code [level vm prefix]
+  (each [ientity entity (ipairs level.objects)]
+    (when (not entity.advanced)
+      (let [code []]
+        (each [iaction action (ipairs (or entity.steps []))]
+          (lume.push code (actions.generate action vm iaction)))
+        (vm:word (.. prefix ientity) (table.unpack code))))))
+
+(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 (readjson mapfile))
+  (local map (. files.game.levels ilevel))
   (local entity (require :game.entity))
   (append-map map org label)
   (entity.append-from-map map org label)
   (set level.vm.code org)
+  (generate-entity-code map level.vm (.. label "-entity-word-"))
   level)
 
 (fn say-runon [portrait ...]
-  (local result [:vm (.. :draw-p portrait)])
+  (local result [:vm (.. :draw-portrait- portrait)])
   (local lines [...])
   (local ilineOffset (if (< (length lines) 4) 1 0))
   (each [iline line (ipairs lines)]
@@ -161,10 +172,9 @@
   (table.insert result :dismiss-dialog)
   result)
 
-(local tilelist (tiles.loadgfx tiles.fn-tiles))
-(fn itile [label] (tiles.find-itile tilelist label))
+(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 : tilelist}
+{: vm : prg : mapw : maph : mon : org : achar : astr : style : rot8l : deflevel : say : say-runon : itile}
 

game/entity.fnl

@@ -100,10 +100,10 @@
     (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]
+      [:ref (if entity.advanced entity.func (.. prefix "-entity-word-" ientity))]
+      (if (and entity.advanced entity.linkword (> (length entity.linkword) 0)) [:ref entity.linkword] [:dw 0])
+      (if entity.link                             [:ref (.. prefix "-entity-" entity.link)]
+          (and entity.advanced entity.linkentity) [:ref entity.linkentity]
         [:dw 0]))))
 
 {: ev : append-from-map}

game/files.fnl

@@ -1,21 +1,39 @@
 (local util (require :lib.util))
 (local lume (require :lib.lume))
-(local tile (require :game.tiles))
 (local tiledraw (require :editor.tiledraw))
 
 (local files (util.hot-table ...))
 
 (local filename "game/game.json")
 
+
+(local encoded-tile-fields [:gfx :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 tile-deserialize [tile]
+  (match (type tile)
+    :string {:gfx (tile:fromhex) :flags {}}
+    :table  (convert-all tile :fromhex)))
+
+(fn tile-serialize [tile] (convert-all (lume.clone tile) :tohex))
+
 (fn deserialize [key value]
   (match key
-    (where (or :tiles :portraits :font)) (tile.deserialize value)
+    (where (or :tiles :portraits :font)) (tile-deserialize value)
     :levels (do (set value.map (value.map:fromhex)) value)
     _ value))
 
 (fn serialize [key value]
   (match key
-    (where (or :tiles :portraits :font)) (tile.serialize value)
+    (where (or :tiles :portraits :font)) (tile-serialize value)
     :levels (do (set value.map (value.map:tohex)) value)
     _ value))
 

game/init.fnl

@@ -2,6 +2,7 @@
 (local {: lo : hi : readjson} util)
 (local tile (util.reload :game.tiles))
 (local {: prg : vm : org} (util.reload :game.defs))
+(local files (require :game.files))
 
 (local disk (util.reload :game.disk))
 
@@ -14,7 +15,7 @@
 
 (tile.appendtiles org.code)
 (org.code:append [:align 0x100] :font)
-(tile.appendgfx org.code (tile.loadgfx tile.fn-font))
+(tile.appendgfx org.code files.game.font)
 (tile.append-portraitwords vm)
 
 (vm:var :tick-count)

game/tiles.fnl

@@ -1,50 +1,21 @@
 (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))))
 
-(local encoded-tile-fields [:gfx :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]
-  (if (util.file-exists 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]
+(fn appendgfx [org gfx ?key ?label-prefix]
   (each [_ g (ipairs gfx)]
-    (when (and g.label (not ?ignore-labels)) (org:append g.label))
+    (when g.label (org:append (.. (or ?label-prefix "") g.label)))
     (org:append [:bytes (. g (or ?key :gfx))])))
 
 (fn appendtiles [org]
-  (local tiles (loadgfx fn-tiles))
+  (local tiles files.game.tiles)
   (org:append [:align 0x100] :tileset)
   (appendgfx org tiles)
-  (appendgfx org (loadgfx fn-portraits))
+  (appendgfx org files.game.portraits nil :portrait-)
   (org:append :tileflags)
   (each [_ tile (ipairs tiles)]
     (var flags 0)
@@ -54,11 +25,11 @@
 
 (fn append-portraitwords [vm ?overrides]
   (local overrides (or ?overrides {}))
-  (each [_ p (ipairs (loadgfx fn-portraits))]
-    (let [wordname (.. :draw- p.label)
+  (each [_ p (ipairs files.game.portraits)]
+    (let [wordname (.. :draw-portrait- p.label)
           override (. overrides p.label)]
-      (vm:word (.. :draw- p.label) :show-footer
-        (if override (override p.label) [:vm :lit p.label])
+      (vm:word wordname :show-footer
+        (if override (override p.label) [:vm :lit (.. :portrait- p.label)])
         :draw-portrait))))
 
 (fn encode-yx [xy]
@@ -81,6 +52,6 @@
   (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 : serialize : deserialize}
+{: appendtiles : appendgfx : append-portraitwords : flags : flag-to-bit : find-itile
+ : encode-yx : encode-itile : decode-itile}
 

lib/fennel.lua

@@ -2223,8 +2223,8 @@ package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or funct
     return table.concat(utils.map(exprs, 1), ", ")
   end
   local function disambiguate_parens(code, chunk)
-    if ((code:byte() == 40) and (1 < #chunk)) then
-      return ("; " .. code)
+    if (code:byte() == 40) then
+      return ("do end " .. code)
     else
       return code
     end