Fix codegen, implement 8bitsy dialog editor

This commit is contained in:
Jeremy Penner 2021-04-24 23:39:50 -04:00
parent a8d77b232c
commit fdf69b8b11
14 changed files with 139 additions and 106 deletions

Binary file not shown.

View file

@ -179,7 +179,7 @@
(fn process-pdat [pdat process default ...] (fn process-pdat [pdat process default ...]
(fn complain [ok ...] (fn complain [ok ...]
(if ok (values ...) (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)) (local processor (. pdat-processor pdat.type process))
(if processor (complain (pcall #(processor pdat $...) ...)) default)) (if processor (complain (pcall #(processor pdat $...) ...)) default))
@ -256,7 +256,6 @@
(local block-env (make-env block env)) (local block-env (make-env block env))
(var bytes "") (var bytes "")
(each [_ pdat (ipairs block.pdats)] (each [_ pdat (ipairs block.pdats)]
(print pdat.type pdat.addr pdat.nearest-symbol)
(process-pdat pdat :generate nil block-env) (process-pdat pdat :generate nil block-env)
(local pdatbytes (process-pdat pdat :bytes pdat.bytes block-env)) (local pdatbytes (process-pdat pdat :bytes pdat.bytes block-env))
(assert (= (type pdatbytes) :string) (.. "failed to generate bytes: " (fv pdat))) (assert (= (type pdatbytes) :string) (.. "failed to generate bytes: " (fv pdat)))

29
editor/8bitsy.fnl Normal file
View file

@ -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))))))
{}

View file

@ -9,4 +9,11 @@
(defmethod actions.edit :default (fn [action view x y w i] y)) (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 actions.hot

View file

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

View file

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

View file

@ -1,9 +1,4 @@
; TODO: Generate from data? ; TODO: Generate from data?
(local {: vm : say : deflevel} (require :game.defs)) (local {: vm : say : deflevel} (require :game.defs))
(deflevel "game/map1.json" :map1) (deflevel 1 :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."))

View file

@ -4,7 +4,9 @@
(local asm (require :asm.asm)) (local asm (require :asm.asm))
(local VM (require :asm.vm)) (local VM (require :asm.vm))
(local tiles (require :game.tiles)) (local tiles (require :game.tiles))
(local files (require :game.files))
(local Prodos (require :asm.prodos)) (local Prodos (require :asm.prodos))
(local actions (require :editor.actions))
(local prg (asm.new)) (local prg (asm.new))
(local vm (VM.new prg {:org 0xc00})) (local vm (VM.new prg {:org 0xc00}))
@ -123,7 +125,7 @@
(fn append-map [map org label] (fn append-map [map org label]
(org:append (org:append
[:align 0x100] label [:align 0x100] label
[:bytes (map.map:fromhex)] [:bytes map.map]
[:db (length map.objects)] [:db (length map.objects)]
[:dw (tiles.encode-yx map.player)] [:dw (tiles.encode-yx map.player)]
[:jmp (if (= (or map.tickword "") "") :next map.tickword)] [:jmp (if (= (or map.tickword "") "") :next map.tickword)]
@ -138,18 +140,27 @@
(vm:word :map-specific-move :map 246 :+ :execute) (vm:word :map-specific-move :map 246 :+ :execute)
(vm:word :map-specific-load :map 249 :+ :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 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 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)) (local entity (require :game.entity))
(append-map map org label) (append-map map org label)
(entity.append-from-map map org label) (entity.append-from-map map org label)
(set level.vm.code org) (set level.vm.code org)
(generate-entity-code map level.vm (.. label "-entity-word-"))
level) level)
(fn say-runon [portrait ...] (fn say-runon [portrait ...]
(local result [:vm (.. :draw-p portrait)]) (local result [:vm (.. :draw-portrait- portrait)])
(local lines [...]) (local lines [...])
(local ilineOffset (if (< (length lines) 4) 1 0)) (local ilineOffset (if (< (length lines) 4) 1 0))
(each [iline line (ipairs lines)] (each [iline line (ipairs lines)]
@ -161,10 +172,9 @@
(table.insert result :dismiss-dialog) (table.insert result :dismiss-dialog)
result) result)
(local tilelist (tiles.loadgfx tiles.fn-tiles)) (fn itile [label] (tiles.find-itile files.game.tiles label))
(fn itile [label] (tiles.find-itile tilelist label))
(set vm.code org.code) (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}

View file

@ -100,10 +100,10 @@
(entity-org:append (entity-org:append
(.. prefix "-entity-" ientity) (.. prefix "-entity-" ientity)
[:db (- entity.x 1)] [:db (- entity.y 1)] [:db (- entity.x 1)] [:db (- entity.y 1)]
[:ref entity.func] [:ref (if entity.advanced entity.func (.. prefix "-entity-word-" ientity))]
(if (and entity.linkword (> (length entity.linkword) 0)) [:ref entity.linkword] [:dw 0]) (if (and entity.advanced entity.linkword (> (length entity.linkword) 0)) [:ref entity.linkword] [:dw 0])
(if entity.link [:ref (.. prefix "-entity-" entity.link)] (if entity.link [:ref (.. prefix "-entity-" entity.link)]
entity.linkentity [:ref entity.linkentity] (and entity.advanced entity.linkentity) [:ref entity.linkentity]
[:dw 0])))) [:dw 0]))))
{: ev : append-from-map} {: ev : append-from-map}

View file

@ -1,21 +1,39 @@
(local util (require :lib.util)) (local util (require :lib.util))
(local lume (require :lib.lume)) (local lume (require :lib.lume))
(local tile (require :game.tiles))
(local tiledraw (require :editor.tiledraw)) (local tiledraw (require :editor.tiledraw))
(local files (util.hot-table ...)) (local files (util.hot-table ...))
(local filename "game/game.json") (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] (fn deserialize [key value]
(match key (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) :levels (do (set value.map (value.map:fromhex)) value)
_ value)) _ value))
(fn serialize [key value] (fn serialize [key value]
(match key (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) :levels (do (set value.map (value.map:tohex)) value)
_ value)) _ value))

File diff suppressed because one or more lines are too long

View file

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

View file

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

View file

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