Fix codegen, implement 8bitsy dialog editor
This commit is contained in:
parent
a8d77b232c
commit
fdf69b8b11
BIN
8Bitsy.dsk
BIN
8Bitsy.dsk
Binary file not shown.
|
@ -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
29
editor/8bitsy.fnl
Normal 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))))))
|
||||||
|
|
||||||
|
{}
|
|
@ -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
|
||||||
|
|
|
@ -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")))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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."))
|
|
||||||
|
|
||||||
|
|
|
@ -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}
|
||||||
|
|
||||||
|
|
|
@ -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}
|
||||||
|
|
|
@ -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
|
@ -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)
|
||||||
|
|
|
@ -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}
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue