Implement tileset switching

asm/asm.fnl

@@ -151,6 +151,7 @@
   (fn dat-parser.export [label block]
     (tset block.globals (. label 2) true)
     nil)
+  (fn dat-parser.pad [pad] {:type :pad :align (. pad 2)})
 
   (local pdat-processor {
     :op {}
@@ -158,6 +159,7 @@
     :ref {}
     :raw {}
     :block {}
+    :pad {}
   })
 
   (fn process-pdat [pdat process default ...]
@@ -176,6 +178,7 @@
   (fn pdat-processor.op.size [op] (size op.mode))
   (fn pdat-processor.var.size [d] d.size)
   (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]
     (local bytegen (. opcodes op.opcode))
@@ -205,6 +208,7 @@
   (fn pdat-processor.ref.bytes [ref env]
     (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]
     (lume.keys block.symbols))
 

asm/vm.fnl

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

editor/gfxedit.fnl

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

editor/tiledraw.fnl

@@ -68,7 +68,7 @@
         (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)))))))
 
-(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]
   (local top (tilestrip-to-sprite [(gfx:sub 1 32) (gfx:sub 65 96)]))
@@ -87,12 +87,13 @@
    :spritegen (or ?spritegen tile-to-sprite)
    :tilesprites []
    :tile (fn [self itile] (or (. self.tiles itile) {:flags {}}))
+   :cachekey (fn [itile ?key] (.. (or ?key :gfx) itile))
    :update-tile
-   (fn [self itile tile]
+   (fn [self itile tile ?key]
      (tset self.tiles itile
        (-> (self:tile itile)
-         (doto (tset :gfx tile))))
-     (tset self.tilesprites itile nil))
+         (doto (tset (or ?key :gfx) tile))))
+     (tset self.tilesprites (self.cachekey itile ?key) nil))
    :set-flag
    (fn [self itile flag clear]
      (tset (. self.tiles itile :flags) flag (if clear nil true)))
@@ -101,10 +102,11 @@
      (set self.tiles tiles)
      (set self.tilesprites []))
    :sprite
-   (fn [self itile]
-     (when (and (= nil (. self.tilesprites itile)) (not= nil (. self.tiles itile)))
-       (tset self.tilesprites itile (self.spritegen (. self.tiles itile :gfx))))
-     (. self.tilesprites itile))})
+   (fn [self itile ?key]
+     (local key (self.cachekey itile ?key))
+     (when (and (= nil (. self.tilesprites key)) (not= nil (. self.tiles 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}
 

editor/tileedit.fnl

@@ -47,7 +47,7 @@
 
 (fn TileView.tile [self]
   (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]
   (when (not (active? self :tile))
@@ -85,7 +85,7 @@
     (self:draw-tile-flag flagname x (+ y (* (+ iflag 1) (+ pixel-size 4))))))
 
 (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))
 
@@ -94,7 +94,8 @@
   (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))
   (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")
 

game/defs.fnl

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

game/gfx.fnl

@@ -124,15 +124,22 @@
     :<rot :drawmaprow :swap
   :dup :not) :drop :drop :player-redraw)
 
+(vm.code:append :tilepage [:db (hi org.tiles.org)])
 (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 #(hi org.tiles.org)]
+  [:clc] [:adc :tilepage]
   [:sta vm.TOPH :x]
   [:tya] [:and 0xe0]
   [: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
   0x2252 :over :drawtile

game/player.fnl

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

game/tiles.fnl

@@ -20,14 +20,16 @@
 (fn loadgfx [filename]     (lume.map (util.readjson filename) deserialize))
 (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)]
-    (when g.label (org:append g.label))
-    (org:append [:bytes g.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))
   (appendgfx org tiles)
+  (org:append [:pad 0x100] :neut-tileset)
+  (appendgfx org tiles :neut true)
   (appendgfx org (loadgfx fn-portraits))
   (org:append :tileflags)
   (each [_ tile (ipairs tiles)]