I'm drawing lots of tiles!! also support locals in inline asm

This commit is contained in:
Jeremy Penner 2021-09-05 23:29:16 -04:00
parent f833e62d91
commit 7a3436dc7e
9 changed files with 90 additions and 37 deletions

View file

@ -20,7 +20,6 @@
(fn GraphicsEditView.get_scrollable_size [self] self.scrollheight)
(fn GraphicsEditView.resource-key [self] :tiles)
(fn GraphicsEditView.tilesize [self] (values 16 16))
(fn GraphicsEditView.tilebytelen [self] (let [(w h) (self:tilesize)] (/ (* w h) 8)))
(fn GraphicsEditView.reload [self] (files.reload))
(fn GraphicsEditView.save [self] (files.save))
@ -36,7 +35,7 @@
(var tilex x)
(var tiley y)
(var (pixw pixh) (self:tilesize))
(set pixw (* (/ pixw 8) 7))
(when (= files.game.platform :ii) (set pixw (* (/ pixw 8) 7)))
(local tilew (* self.sprite-scale pixw))
(local tileh (* self.sprite-scale pixh))
(for [itile 1 (length self.tilecache.tiles)]

View file

@ -10,10 +10,16 @@
(local MapEditView (GraphicsEditView:extend))
(local sprite-scale 3)
(local mapw 20)
(local maph 12)
(local tilew (* sprite-scale 14))
(local tileh (* sprite-scale 16))
(local platforms {
:ii {:mapw 20 :maph 12 :tilew 14 :tileh 16}
:iigs {:mapw 20 :maph 12 :tilew 16 :tileh 16}
})
(local platform (. platforms (files.platform)))
(local {: mapw : maph} platform)
(local tilew (* sprite-scale platform.tilew))
(local tileh (* sprite-scale platform.tileh))
(fn MapEditView.new [self]
(MapEditView.super.new self)
@ -60,10 +66,15 @@
(when (. objects (+ iobjectsrc 1))
(move-object objects (+ iobjectsrc 1) iobjectsrc)))
(fn MapEditView.levels [self]
(when (= files.game.levels nil)
(set files.game.levels []))
files.game.levels)
(fn MapEditView.draw-map-selector [self x y]
(renderer.draw_text style.font "Map" x (+ y (/ style.padding.y 2)) style.text)
(let [options {}
level-count (length files.game.levels)
level-count (length (self:levels))
_ (do (for [i 1 level-count] (tset options i i))
(table.insert options :New))
(ilevel yNext) (dropdown self :map-selector self.ilevel options (+ x (* 50 SCALE)) y (* 100 SCALE))]
@ -222,9 +233,9 @@
(fn MapEditView.load-level [self]
(set self.stripcache {})
(when (= (. files.game.levels self.ilevel) nil)
(tset files.game.levels self.ilevel {:map (string.rep "\0" (* mapw maph)) :objects []}))
(set self.level (. files.game.levels self.ilevel))
(when (= (. (self:levels) self.ilevel) nil)
(tset (self:levels) self.ilevel {:map (string.rep "\0" (* mapw maph)) :objects []}))
(set self.level (. (self:levels) self.ilevel))
(set self.iobject nil))
(fn MapEditView.reload [self]

View file

@ -21,9 +21,16 @@
canvas)
(files.platform-methods TileDraw :editor.tiledraw
:tile-to-sprite :char-to-sprite :portrait-to-sprite :screen-to-sprite :screen-y-to-offset :tilestrip-to-sprite
:tile-to-sprite :char-to-sprite :portrait-to-sprite :screen-to-sprite :screen-y-to-offset
:pal-from-bit :pal-from-byte :draw-byte)
(files.default-platform-method TileDraw :editor.tiledraw :tilestrip-to-sprite
(fn [tiles]
(let [sprites (icollect [_ tile (ipairs tiles)] (TileDraw.tile-to-sprite tile))]
(TileDraw.make-canvas (* (: (. sprites 1) :getWidth) (length sprites)) (: (. sprites 1) :getHeight)
#(each [isprite sprite (ipairs sprites)]
(love.graphics.draw sprite (* (sprite:getWidth) (- isprite 1)) 0))))))
(fn TileDraw.TileCache [tiles ?spritegen]
{: tiles
:spritegen (or ?spritegen TileDraw.tile-to-sprite)

View file

@ -14,6 +14,7 @@
(fn TileView.tilekeys [self]
(if files.game.tilesets (icollect [_ key (pairs files.game.tilesets)] key)
[:gfx]))
(fn TileView.tilebytelen [self] (let [(w h) (self:tilesize)] (/ (* w h) (self:pixel-storage-divisor))))
(fn get-byte [tile ibyte]
(or (: (tile:sub (+ ibyte 1) (+ ibyte 1)) :byte) 0))

View file

@ -90,10 +90,10 @@
(or files.game.module (: (filename) :match "^[^/]+")))
(fn files.platform [] (or files.game.platform :ii))
(fn files.default-platform-method [cls module-prefix method default]
(tset cls method (fn [...] (let [f (. (require (.. module-prefix :. (files.platform))) method)] (if f (f ...) (default ...))))))
(fn files.platform-methods [cls module-prefix ...]
(each [_ key (ipairs [...])]
(tset cls key (fn [...] (let [f (. (require (.. module-prefix :. (files.platform))) key)]
(when f (f ...)))))))
(each [_ key (ipairs [...])] (files.default-platform-method cls module-prefix key #nil)))
(when (= files.game nil)
(files.load))

View file

@ -1 +1 @@
{"platform":"iigs","tiles":[{"flags":[],"word":"","label":"","gfx":"FFFFFFFFFFFFFFFFFAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3F3333333F3333333FFFFFFFFFFFFFFFFFAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3FAAAAAA3F3333333F3333333"}]}
{"tiles":[{"flags":[],"word":"","label":"","gfx":"77777777777777777FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF1711111117111111177777777777777777FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17FFFFFF17111111171111111"},{"flags":[],"word":"","label":"","gfx":"7777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777799999999999999999999999999999999"},{"flags":[],"word":"","label":"","gfx":"7777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777777"}],"platform":"iigs","levels":[{"loadword":"","objects":[],"tickword":"","moveword":"","map":"000000000000000000000000000000000000000000000000000000000000000000000000000000000000002000000000200000000000000000000000000000400000000040000000000000000000000000000040000020204000000000000000000000000000004000004000000000000000000000000000000000402020400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"}]}

View file

@ -47,15 +47,17 @@
(lume.concat [:block] (table.unpack writes))))])
(fn draw-tile (tile (long addr))
(let (y 0)
(while (< y 16)
(word! addr (word-at tile))
(word! (+ addr 2) (word-at (+ tile 2)))
(word! (+ addr 4) (word-at (+ tile 4)))
(word! (+ addr 6) (word-at (+ tile 6)))
(set! addr (+ addr 160))
(set! tile (+ tile 8))
(set! y (+ y 1)))))
(asm
(lda addr) (sta [ssc.ADDR_LO])
(lda addr 2) (sta [ssc.ADDR_HI])
(ldy 0) (ldx 16) (clc)
loop
(lda (tile) :y) (sta (([ssc.ADDR_LO])) :y) (iny) (iny)
(lda (tile) :y) (sta (([ssc.ADDR_LO])) :y) (iny) (iny)
(lda (tile) :y) (sta (([ssc.ADDR_LO])) :y) (iny) (iny)
(lda (tile) :y) (sta (([ssc.ADDR_LO])) :y) (iny) (iny)
(lda [ssc.ADDR_LO]) (adc 152) (sta [ssc.ADDR_LO])
(dex) (bne loop)))
(global word userID)
@ -65,6 +67,17 @@
(yield)
(set! i (+ i 1)))))
(fn draw-test-tiles ()
(let (x 0 y 0 screen screen-addr)
(while (< y 12)
(draw-tile (ref tiles) screen)
(set! x (+ x 1))
(if (= x 20)
(do (set! x 0)
(set! y (+ y 1))
(set! screen (+ screen [(+ 8 (* 160 15))])))
(set! screen (+ screen 8))))))
(fn main ()
(LoadTools (far-ref toolsets))
(set! userID (MMStartUp))
@ -76,7 +89,8 @@
(set-palette 0 [pal])
(SetAllSCBs 0)
(draw-tile (ref tiles) screen-addr)
(draw-test-tiles)
(wait-for-key)
(GrafOff)

View file

@ -69,9 +69,11 @@
opgen.hi :long
:word)
c-setup (when opgen.setup (opgen.setup))
c-lo [(opgen.lo :lda) [:pha]]
c-hi (when opgen.hi [(opgen.hi :lda) [:pha]])]
(table.insert self.locals {: name :type etype})
c-hi (when opgen.hi [(opgen.hi :lda) [:pha]])
loc {: name :type :word}
_ (table.insert self.locals loc)
c-lo [(opgen.lo :lda) [:pha]]]
(set loc.type etype)
(lume.concat [:block c-setup] c-hi c-lo)))
(fn Ssc.remove-local [self ?name]
@ -194,8 +196,16 @@
(set self.locals [])
{:arity (length args) :args arglocals :org self.org :type etype : name})
(fn Ssc.asm-localify [self block]
(icollect [_ inst (ipairs block)]
(match inst
(where [op loc ?off] (self:local-offset loc)) [op (+ (self:local-offset loc) (or ?off 0)) :s]
(where [op [loc ?off] :y] (self:local-offset loc)) [op [(+ (self:local-offset loc) (or ?off 0)) :s] :y]
[:block] (self:asm-localify inst)
_ inst)))
(set Ssc.forms
{:asm (fn [self ...] (if (self:defining?) [:block ...] (self.org:append ...)))
{:asm (fn [self ...] (if (self:defining?) (self:asm-localify [:block ...]) (self.org:append (table.unpack (self:asm-localify [...])))))
:asm-long (fn [self ...] (values [:block ...] :long))
:org (lambda [self org] (set self.org (self.prg:org org)))
:start-symbol (lambda [self symbol] (set self.prg.start-symbol symbol))

View file

@ -25,6 +25,14 @@
(table.insert files item.filename)))
(common.fuzzy_match files text))))})
(fn selected-symbol []
(local ldoc core.active_view.doc)
(var (aline acol bline bcol) (ldoc:get_selection))
(when (and (= aline bline) (= acol bcol))
(set (aline acol) (translate.start_of_word ldoc aline acol))
(set (bline bcol) (translate.end_of_word ldoc bline bcol)))
(ldoc:get_text aline acol bline bcol))
(command.add #(link.machine:connected?) {
"honeylisp:upload" (fn []
(local p (util.reload "game"))
@ -50,18 +58,20 @@
(editor.inline-eval vm-eval))
})
(command.add #(and (link.machine:connected?) link.machine.set-bp) {
"honeylisp:set-breakpoint" (fn []
(local word (selected-symbol))
(local p (require "game"))
(local addr (p:lookup-addr word))
(if addr (do (link.machine:set-bp addr)
(core.log (.. "Set breakpoint at " addr)))
(core.log (.. "Unknown address for " word))))
})
(command.add (fn [] true) {
"honeylisp:rebuild" #(util.reload "game")
})
(fn selected-symbol []
(local ldoc core.active_view.doc)
(var (aline acol bline bcol) (ldoc:get_selection))
(when (and (= aline bline) (= acol bcol))
(set (aline acol) (translate.start_of_word ldoc aline acol))
(set (bline bcol) (translate.end_of_word ldoc bline bcol)))
(ldoc:get_text aline acol bline bcol))
(command.add "core.docview" {
"fennel:eval" #(editor.inline-eval #(fv (fennel.eval $1 {:env _G :compiler-env _G}) {}))
"lume:hotswap" (fn []
@ -85,6 +95,7 @@
"alt+v" "honeylisp:vm-eval"
"alt+r" "lume:hotswap"
"alt+a" "honeylisp:address"
"alt+b" "honeylisp:set-breakpoint"
"alt+l" "honeylisp:reload"
})