Implement tileset switching

This commit is contained in:
Jeremy Penner 2020-12-23 22:17:33 -05:00
parent 8a4d92b6ff
commit 7115252b62
10 changed files with 62 additions and 43 deletions

View file

@ -151,6 +151,7 @@
(fn dat-parser.export [label block] (fn dat-parser.export [label block]
(tset block.globals (. label 2) true) (tset block.globals (. label 2) true)
nil) nil)
(fn dat-parser.pad [pad] {:type :pad :align (. pad 2)})
(local pdat-processor { (local pdat-processor {
:op {} :op {}
@ -158,6 +159,7 @@
:ref {} :ref {}
:raw {} :raw {}
:block {} :block {}
:pad {}
}) })
(fn process-pdat [pdat process default ...] (fn process-pdat [pdat process default ...]
@ -176,6 +178,7 @@
(fn pdat-processor.op.size [op] (size op.mode)) (fn pdat-processor.op.size [op] (size op.mode))
(fn pdat-processor.var.size [d] d.size) (fn pdat-processor.var.size [d] d.size)
(fn pdat-processor.ref.size [r] 2) (fn pdat-processor.ref.size [r] 2)
(fn pdat-processor.pad.size [pad] (- pad.align (% pad.addr pad.align)))
(fn pdat-processor.op.bytes [op env] (fn pdat-processor.op.bytes [op env]
(local bytegen (. opcodes op.opcode)) (local bytegen (. opcodes op.opcode))
@ -205,6 +208,7 @@
(fn pdat-processor.ref.bytes [ref env] (fn pdat-processor.ref.bytes [ref env]
(int16-to-bytes (env:lookup-addr ref.target))) (int16-to-bytes (env:lookup-addr ref.target)))
(fn pdat-processor.pad.bytes [pad] (string.rep "\0" pad.size))
(fn pdat-processor.block.symbols [block] (fn pdat-processor.block.symbols [block]
(lume.keys block.symbols)) (lume.keys block.symbols))

View file

@ -68,7 +68,7 @@
:ST1H :0x7f :ST1H :0x7f
:ST2 :0x7c :ST2 :0x7c
:ST2H :0x7d :ST2H :0x7d
:RSTACK :0x6000 :RSTACK :0x100
:true 0xffff :true 0xffff
:false 0 :false 0
:code code1 :code code1
@ -492,7 +492,7 @@
[:lda vm.TOP :x] [:ora vm.ST1 :x] [:sta vm.ST1 :x] [:lda vm.TOP :x] [:ora vm.ST1 :x] [:sta vm.ST1 :x]
[:lda vm.TOPH :x] [:ora vm.ST1H :x] [:sta vm.ST1H :x] [:lda vm.TOPH :x] [:ora vm.ST1H :x] [:sta vm.ST1H :x]
(vm:drop)) (vm:drop))
(vm:def :shl4 ; n -- n (vm:def :shl4 ; n -- n
[:asl vm.TOP :x] [:rol vm.TOPH :x] [:asl vm.TOP :x] [:rol vm.TOPH :x]
[:asl vm.TOP :x] [:rol vm.TOPH :x] [:asl vm.TOP :x] [:rol vm.TOPH :x]

View file

@ -25,10 +25,10 @@
(local itile (+ self.itile ditile)) (local itile (+ self.itile ditile))
(when (>= itile 1) (set self.itile itile)))) (when (>= itile 1) (set self.itile itile))))
(fn GraphicsEditView.draw-sprite [self x y itile] (fn GraphicsEditView.draw-sprite [self x y itile ?key]
(love.graphics.draw (self.tilecache:sprite itile) x y 0 self.sprite-scale self.sprite-scale)) (love.graphics.draw (self.tilecache:sprite itile ?key) x y 0 self.sprite-scale self.sprite-scale))
(fn GraphicsEditView.draw-tile-selector [self x y w] (fn GraphicsEditView.draw-tile-selector [self x y w ?key]
(var tilex x) (var tilex x)
(var tiley y) (var tiley y)
(var (pixw pixh) (self:tilesize)) (var (pixw pixh) (self:tilesize))
@ -36,14 +36,16 @@
(local tilew (* self.sprite-scale pixw)) (local tilew (* self.sprite-scale pixw))
(local tileh (* self.sprite-scale pixh)) (local tileh (* self.sprite-scale pixh))
(for [itile 1 (length self.tilecache.tiles)] (for [itile 1 (length self.tilecache.tiles)]
(self:draw-sprite tilex tiley itile) (self:draw-sprite tilex tiley itile ?key)
(when (= itile self.itile) (when (and (= itile self.itile) (= ?key self.tilekey))
(love.graphics.rectangle :line (- tilex 2) (- tiley 2) (+ tilew 4) (+ tileh 4))) (love.graphics.rectangle :line (- tilex 2) (- tiley 2) (+ tilew 4) (+ tileh 4)))
(when (button self [:tile itile] tilex tiley tilew tileh) (when (button self [:tile itile] tilex tiley tilew tileh)
(set self.itile itile)) (set self.itile itile)
(set self.tilekey ?key))
(set tilex (+ tilex tilew 4)) (set tilex (+ tilex tilew 4))
(when (>= (+ tilex tilew) (+ x w)) (when (>= (+ tilex tilew) (+ x w))
(set tilex x) (set tilex x)
(set tiley (+ tiley tileh 4))))) (set tiley (+ tiley tileh 4))))
(+ tiley tileh (- y)))
GraphicsEditView GraphicsEditView

View file

@ -68,7 +68,7 @@
(set (state prevpal) (draw-byte tile (+ y 1) x y state prevpal)) (set (state prevpal) (draw-byte tile (+ y 1) x y state prevpal))
(set (state prevpal) (draw-byte tile (+ y 17) (+ x 7) y state prevpal))))))) (set (state prevpal) (draw-byte tile (+ y 17) (+ x 7) y state prevpal)))))))
(fn tile-to-sprite [tile] (tilestrip-to-sprite [tile])) (fn tile-to-sprite [tile] (if tile (tilestrip-to-sprite [tile]) (make-canvas 14 16 #nil)))
(fn portrait-to-sprite [gfx] (fn portrait-to-sprite [gfx]
(local top (tilestrip-to-sprite [(gfx:sub 1 32) (gfx:sub 65 96)])) (local top (tilestrip-to-sprite [(gfx:sub 1 32) (gfx:sub 65 96)]))
@ -87,12 +87,13 @@
:spritegen (or ?spritegen tile-to-sprite) :spritegen (or ?spritegen tile-to-sprite)
:tilesprites [] :tilesprites []
:tile (fn [self itile] (or (. self.tiles itile) {:flags {}})) :tile (fn [self itile] (or (. self.tiles itile) {:flags {}}))
:cachekey (fn [itile ?key] (.. (or ?key :gfx) itile))
:update-tile :update-tile
(fn [self itile tile] (fn [self itile tile ?key]
(tset self.tiles itile (tset self.tiles itile
(-> (self:tile itile) (-> (self:tile itile)
(doto (tset :gfx tile)))) (doto (tset (or ?key :gfx) tile))))
(tset self.tilesprites itile nil)) (tset self.tilesprites (self.cachekey itile ?key) nil))
:set-flag :set-flag
(fn [self itile flag clear] (fn [self itile flag clear]
(tset (. self.tiles itile :flags) flag (if clear nil true))) (tset (. self.tiles itile :flags) flag (if clear nil true)))
@ -101,10 +102,11 @@
(set self.tiles tiles) (set self.tiles tiles)
(set self.tilesprites [])) (set self.tilesprites []))
:sprite :sprite
(fn [self itile] (fn [self itile ?key]
(when (and (= nil (. self.tilesprites itile)) (not= nil (. self.tiles itile))) (local key (self.cachekey itile ?key))
(tset self.tilesprites itile (self.spritegen (. self.tiles itile :gfx)))) (when (and (= nil (. self.tilesprites key)) (not= nil (. self.tiles itile)))
(. self.tilesprites itile))}) (tset self.tilesprites key (self.spritegen (. self.tiles itile (or ?key :gfx)))))
(. self.tilesprites key))})
{: tile-to-sprite : tilestrip-to-sprite : portrait-to-sprite : char-to-sprite : pal-from-bit : pal-from-byte : TileCache} {: tile-to-sprite : tilestrip-to-sprite : portrait-to-sprite : char-to-sprite : pal-from-bit : pal-from-byte : TileCache}

View file

@ -47,7 +47,7 @@
(fn TileView.tile [self] (fn TileView.tile [self]
(local (w h) (self:tilesize)) (local (w h) (self:tilesize))
(or (-?> self.tilecache.tiles (. self.itile) (. :gfx)) (string.rep "\0" (/ (* w h) 8)))) (or (-?> self.tilecache.tiles (. self.itile) (. (or self.tilekey :gfx))) (string.rep "\0" (/ (* w h) 8))))
(fn TileView.draw-tile-editor [self tile x y] (fn TileView.draw-tile-editor [self tile x y]
(when (not (active? self :tile)) (when (not (active? self :tile))
@ -85,7 +85,7 @@
(self:draw-tile-flag flagname x (+ y (* (+ iflag 1) (+ pixel-size 4)))))) (self:draw-tile-flag flagname x (+ y (* (+ iflag 1) (+ pixel-size 4))))))
(fn TileView.update-tile [self newtile] (fn TileView.update-tile [self newtile]
(self.tilecache:update-tile self.itile newtile)) (self.tilecache:update-tile self.itile newtile self.tilekey))
(fn TileView.save [self] (tiles.savegfx (self:filename) self.tilecache.tiles)) (fn TileView.save [self] (tiles.savegfx (self:filename) self.tilecache.tiles))
@ -94,7 +94,8 @@
(local (x y) (values (+ self.position.x 10) (+ self.position.y 10))) (local (x y) (values (+ self.position.x 10) (+ self.position.y 10)))
(local (editor-w editor-h) (self:draw-tile-editor (self:tile) x y)) (local (editor-w editor-h) (self:draw-tile-editor (self:tile) x y))
(self:draw-tile-flags (+ x editor-w pixel-size) y) (self:draw-tile-flags (+ x editor-w pixel-size) y)
(self:draw-tile-selector x (+ y editor-h pixel-size) (- self.size.x 20))) (local top-selector-h (self:draw-tile-selector x (+ y editor-h pixel-size) (- self.size.x 20)))
(self:draw-tile-selector x (+ y editor-h pixel-size top-selector-h pixel-size) (- self.size.x 20) :neut))
(fn TileView.get_name [self] "Tile Editor") (fn TileView.get_name [self] "Tile Editor")

View file

@ -17,11 +17,11 @@
}) })
(local org { (local org {
:tiles (prg:org 0x4100) :tiles (prg:org 0x4000)
:map (prg:org 0x4a00) :font (prg:org 0x4e00)
:font (prg:org 0x4b00) :map (prg:org 0x5000)
:entity (prg:org 0x4d00) :entity (prg:org 0x5100)
:levelcode (prg:org 0x4e00) :levelcode (prg:org 0x5200)
:code vm.code :code vm.code
}) })

View file

@ -124,15 +124,22 @@
:<rot :drawmaprow :swap :<rot :drawmaprow :swap
:dup :not) :drop :drop :player-redraw) :dup :not) :drop :drop :player-redraw)
(vm.code:append :tilepage [:db (hi org.tiles.org)])
(vm:def :lookup-tile ; itile -- ptile (vm:def :lookup-tile ; itile -- ptile
; each tile is 32 bytes; 2^5 ; 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' ; we save some cycles by storing the indices as lllhhhhh, so we don't need to shift them'
[:lda vm.TOP :x] [:tay] [:lda vm.TOP :x] [:tay]
[:and 0x1f] [:and 0x1f]
[:clc] [:adc #(hi org.tiles.org)] [:clc] [:adc :tilepage]
[:sta vm.TOPH :x] [:sta vm.TOPH :x]
[:tya] [:and 0xe0] [:tya] [:and 0xe0]
[:sta vm.TOP :x]) [:sta vm.TOP :x])
(vm:def :set-human-tileset
[:lda #(hi org.tiles.org)]
[:sta :tilepage])
(vm:def :set-prog-tileset
[:lda #(hi ($1:lookup-addr :neut-tileset))]
[:sta :tilepage])
(vm:word :draw-portrait ; pgfx (vm:word :draw-portrait ; pgfx
0x2252 :over :drawtile 0x2252 :over :drawtile

View file

@ -50,7 +50,7 @@
[controlstate.neut :neut-tile] [controlstate.neut :neut-tile]
[controlstate.gord :gord-tile] [controlstate.gord :gord-tile]
[controlstate.libb :libb-tile] [controlstate.libb :libb-tile]
[:else :lit :t-rexx])) [:else (itile :t-rexx)]) :lookup-tile)
(vm:word :player-yx ; -- pyx (vm:word :player-yx ; -- pyx
:controlstate :bget :controlstate :bget
@ -118,22 +118,22 @@
(vm:word :jaye-tile ; ptile (vm:word :jaye-tile ; ptile
:jaye-dir :get :jaye-dir :get
(vm:case [0xff00 :lit :jaye-n] (vm:case [0xff00 (itile :jaye-n)]
[0x0100 :lit :jaye-s] [0x0100 (itile :jaye-s)]
[0x00ff :lit :jaye-w] [0x00ff (itile :jaye-w)]
[:else :lit :jaye-e])) [:else (itile :jaye-e)]))
(vm:word :gord-tile ; ptile (vm:word :gord-tile ; ptile
:gord-sitting :get :gord-sitting :get
(vm:if [:lit :gord-sit] (vm:if [(itile :gord-sit)]
[:gord-dir :get [:gord-dir :get
(vm:case [0xff00 :lit :gord-n] (vm:case [0xff00 (itile :gord-n)]
[0x0100 :lit :gord-s] [0x0100 (itile :gord-s)]
[0x00ff :lit :gord-w] [0x00ff (itile :gord-w)]
[:else :lit :gord-e])])) [:else (itile :gord-e)])]))
(vm:word :neut-tile :lit :neut1) ; todo: animate (vm:word :neut-tile (itile :neut1)) ; todo: animate
(vm:word :libb-tile :lit :libb1) (vm:word :libb-tile (itile :libb1))
(vm:word :flag-at? ; yx flag -- f (vm:word :flag-at? ; yx flag -- f
:swap :itile-at :lookup-flags :&) :swap :itile-at :lookup-flags :&)
@ -142,7 +142,8 @@
(vm:ifchain [:is-prog?] [controlstate.jaye] (vm:ifchain [:is-prog?] [controlstate.jaye]
[:rexx-active?] [controlstate.rexx] [:rexx-active?] [controlstate.rexx]
[:neut-hidden?] [controlstate.jaye] [:neut-hidden?] [controlstate.jaye]
[controlstate.neut]) :controlstate :bset) [controlstate.neut]) :controlstate :bset
:is-prog? (vm:if [:set-prog-tileset] [:set-human-tileset]) :full-redraw)
(vm:word :party-follow (vm:word :party-follow
(vm:if-and [[:is-jaye?] [:gord-following?]] (vm:if-and [[:is-jaye?] [:gord-following?]]

View file

@ -20,14 +20,16 @@
(fn loadgfx [filename] (lume.map (util.readjson filename) deserialize)) (fn loadgfx [filename] (lume.map (util.readjson filename) deserialize))
(fn savegfx [filename gfx] (util.writejson filename (lume.map gfx serialize))) (fn savegfx [filename gfx] (util.writejson filename (lume.map gfx serialize)))
(fn appendgfx [org gfx] (fn appendgfx [org gfx ?key ?ignore-labels]
(each [_ g (ipairs gfx)] (each [_ g (ipairs gfx)]
(when g.label (org:append g.label)) (when (and g.label (not ?ignore-labels)) (org:append g.label))
(org:append [:bytes g.gfx]))) (org:append [:bytes (. g (or ?key :gfx))])))
(fn appendtiles [org] (fn appendtiles [org]
(local tiles (loadgfx fn-tiles)) (local tiles (loadgfx fn-tiles))
(appendgfx org tiles) (appendgfx org tiles)
(org:append [:pad 0x100] :neut-tileset)
(appendgfx org tiles :neut true)
(appendgfx org (loadgfx fn-portraits)) (appendgfx org (loadgfx fn-portraits))
(org:append :tileflags) (org:append :tileflags)
(each [_ tile (ipairs tiles)] (each [_ tile (ipairs tiles)]

File diff suppressed because one or more lines are too long