Sprite compiler!!! had to redraw my tiles
This commit is contained in:
parent
d2ff69258f
commit
432a4fa26a
|
@ -34,7 +34,7 @@
|
|||
[:cld nil] [:cmp :aby] [:phx nil] [:stp nil] [:jmp :iax] [:cmp :abx] [:dec :abx] [:cmp :alx] ; 0xd8-0xdf
|
||||
[:cpx :imm] [:sbc :idx] [:sep :imm] [:sbc :sr] [:cpx :dp] [:sbc :dp] [:inc :dp] [:sbc :idl] ; 0xe0-0xe7
|
||||
[:inx nil] [:sbc :imm] [:nop nil] [:xba nil] [:cpx :abs] [:sbc :abs] [:inc :abs] [:sbc :abl] ; 0xe8-0xef
|
||||
[:beq :rel] [:sbc :idy] [:sbc :idp] [:sbc :isy] [:pea :abs] [:sbc :dpx] [:inc :dpx] [:sbc :idly] ; 0xf0-0xf7
|
||||
[:beq :rel] [:sbc :idy] [:sbc :idp] [:sbc :isy] [:pea :imm] [:sbc :dpx] [:inc :dpx] [:sbc :idly] ; 0xf0-0xf7
|
||||
[:sed nil] [:sbc :aby] [:plx nil] [:xce nil] [:jsr :iax] [:sbc :abx] [:inc :abx] [:sbc :alx] ; 0xf8-0xff
|
||||
]
|
||||
mnemonic-to-modemap {}]
|
||||
|
|
|
@ -29,6 +29,7 @@
|
|||
(when (>= itile 1) (set self.itile itile))))
|
||||
|
||||
(fn GraphicsEditView.draw-sprite [self x y itile ?key]
|
||||
(love.graphics.setColor 1 1 1)
|
||||
(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 ?key]
|
||||
|
|
|
@ -9,12 +9,12 @@
|
|||
(fn tile-to-sprite [tile]
|
||||
(if tile (make-canvas 16 16 (fn [canvas]
|
||||
(for [y 0 15]
|
||||
(for [x 0 15 2]
|
||||
(let [ibyte (+ (* y 8) (math.floor (/ x 2)) 1)
|
||||
(for [x 0 15]
|
||||
(let [ibyte (+ (* y 16) x 1)
|
||||
byte (string.byte (tile:sub ibyte ibyte))
|
||||
left (bit.band (bit.rshift byte 4) 0xf)
|
||||
right (bit.band byte 0xf)]
|
||||
(putpixel x y (gs-to-rgb (. pal (+ left 1))))
|
||||
(putpixel (+ x 1) y (gs-to-rgb (. pal (+ right 1)))))))))))
|
||||
mask (bit.band (bit.rshift byte 4) 0xf)
|
||||
color (bit.band byte 0xf)
|
||||
rgb (if (= mask 0) (gs-to-rgb (. pal (+ color 1))) [255 0 255])]
|
||||
(putpixel x y rgb))))))))
|
||||
|
||||
{: tile-to-sprite : pal : gs-to-rgb}
|
||||
|
|
|
@ -1,12 +1,11 @@
|
|||
(local {: pal : gs-to-rgb} (require :editor.tiledraw.iigs))
|
||||
(local lume (require :lib.lume))
|
||||
|
||||
{:map-bitxy (fn [self x y]
|
||||
(let [ibyte (+ (* y 8) (bit.rshift x 1))
|
||||
ibit (match (% x 2) 0 4 1 0)]
|
||||
(values ibyte ibit 0x0f)))
|
||||
:pixel-color (fn [self b] (gs-to-rgb (. pal (+ b 1))))
|
||||
:draw-bits #(- $1.icolor 1)
|
||||
:palette #(icollect [_ color (ipairs pal)] (gs-to-rgb color))
|
||||
:pixel-storage-divisor #2
|
||||
{:map-bitxy (fn [self x y] (values (+ (* y 16) x) 0 0xff))
|
||||
:pixel-color (fn [self b] (match b 0xf0 (values [128 128 128] [64 64 64])
|
||||
_ (gs-to-rgb (. pal (+ b 1)))))
|
||||
:draw-bits #(if (= $1.icolor 17) 0xf0 (- $1.icolor 1))
|
||||
:palette #(lume.concat (icollect [_ color (ipairs pal)] (gs-to-rgb color)) [[255 0 255]])
|
||||
:pixel-storage-divisor #1
|
||||
}
|
||||
|
||||
|
|
|
@ -1 +1 @@
|
|||
{"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"}]}
|
||||
{"tiles":[{"flags":[],"word":"","label":"","gfx":"0F000E0B07070707070707070707070707070707070707070702070707070707070707070707070702070707070707070707070707070707070707070707070707070707070404040404040707070707070707070505050505050505070707070707070606060606060606060607070707070708080808080808080807070707070707090909090909090907070707070707070B0B0B0B0B0B0B0B0B070707070707070D0D0D0D0D0D0D0D0D0D070707070707070E0E0E0E0E0E0E0E0707070707070707070F0F07070F0F0707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707"},{"flags":[],"word":"","label":"","gfx":"00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000006060000000000000606000000000000000600000000000000060000000000000006000000000000000600000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000060000000000000000000606000000000600000000000000000606000000000000060000000606060600000000000000000606060606000000000000000000000000000000000000000000000000000000000000000000000000000000"},{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00BF0F0F0F0F0F0F0F0F0F005F0F0F00505F0F0F0F0F0F0F0F0F0F00BF0F0F00BF0F0F0F0F0F00BF0F0F0F0F0F0F0F0F0F0F0F0F00B05F0F0F0F0F0F0F0F00B0BF0F0F0F0F0F0F0F0F0F0F0F0F00B05050BF0F0F0F0F0F0F0F00B050BF00B05050BF0F0F0F0F0F0F0F0F0F0F0F0F00B0BF0F00B05F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00B05F0F0F0050BF00BF0F0F0F0F0F0F0F0F005F00BF0F0F005F0F0F0F00BF0F0F0F00BF0F0F0F0F00BF0F0F0F005F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00BF0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0"},{"flags":[],"word":"","label":"","gfx":"00000000000000000000000000000000000000000000000000000000000000000000000E00000000000E0000000000000000000E00000000000E00000000000000000000000000000E0000000E0E0E00000000000000000000000000000000000000000000000E0E0E0E0E0E0000000000000000000E0E080E0E080E0000000000000000000E0E0E0E0E0E0E000E000000000000000E0E0606060E00000E0E00000E0E0E00000E0E0E0E000E00000E0000000000000000000000000E000000000000000000000E00000000000000000000000000000E0E000000000000000000000000000E0E0000000000000000000000000000000000000000000000000000"}],"platform":"iigs","levels":[{"loadword":"","map":"000000000000000000000000000000000000000000000000000000000000000000000000000000000000002000000000200000000000000000000000000000400000000040000000000000000000000000000040000020204000000000000000000000000000004000004000000000000000000000000000000000402020400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000","tickword":"","moveword":"","objects":[]}]}
|
|
@ -39,7 +39,11 @@
|
|||
(const screen-addr 0xe12000)
|
||||
(const screen-size 0x9d00)
|
||||
|
||||
(asm tiles [(lume.concat [:flatten] (icollect [_ tile (ipairs files.game.tiles)] [:bytes tile.gfx]))])
|
||||
(compile-sprite tile0 [(. files.game.tiles 1 :gfx)] 16 16)
|
||||
(compile-sprite tile1 [(. files.game.tiles 2 :gfx)] 16 16)
|
||||
(compile-sprite tile2 [(. files.game.tiles 3 :gfx)] 16 16)
|
||||
(compile-sprite tile3 [(. files.game.tiles 4 :gfx)] 16 16)
|
||||
(asm tiles (jmp tile0) (nop) (jmp tile1) (nop) (jmp tile2) (nop) (jmp :tile3) (nop))
|
||||
|
||||
(form set-palette [(fn [ssc index pal]
|
||||
(let [addr (+ 0xe19e00 (* index 0x20))
|
||||
|
@ -47,32 +51,6 @@
|
|||
[[:lda (bit.bor (bit.lshift r 8) (bit.lshift g 4) b)] [:sta (tostring (+ addr (* icolor 2) -2))]])]
|
||||
(lume.concat [:block] (table.unpack writes))))])
|
||||
|
||||
(fn draw-tile (tile addr)
|
||||
(asm
|
||||
(lda 16) (sta [ssc.LONG_LO]) (clc)
|
||||
(lda tile) (tax) (lda addr) (tay)
|
||||
(phb)
|
||||
(bra draw)
|
||||
loop
|
||||
(tya) (adc 152) (tay)
|
||||
draw
|
||||
(lda 7) (mvn 6 1)
|
||||
(dec [ssc.LONG_LO]) (bne loop)
|
||||
(plb)))
|
||||
|
||||
(fn shadow-rewrite-tile (addr)
|
||||
(asm
|
||||
(lda 16) (sta [ssc.LONG_LO]) (clc)
|
||||
(lda addr) (tay) (tax)
|
||||
(phb)
|
||||
(bra draw)
|
||||
loop
|
||||
(tya) (adc 152) (tay) (tax)
|
||||
draw
|
||||
(lda 7) (mvn 1 1)
|
||||
(dec [ssc.LONG_LO]) (bne loop)
|
||||
(plb)))
|
||||
|
||||
(global word userID)
|
||||
|
||||
(fn print-numbers-forever ()
|
||||
|
@ -82,8 +60,7 @@
|
|||
(set! i (+ i 1)))))
|
||||
|
||||
(form itile-to-tile [(fn [ssc itile]
|
||||
[:block (ssc:expr-word itile) [:asl] [:asl] [:asl] [:asl] [:asl] [:asl] [:asl]
|
||||
[:clc] [:adc #($1:lookup-addr :tiles)]])])
|
||||
[:block (ssc:expr-word itile) [:asl] [:asl] [:clc] [:adc #($1:lookup-addr :tiles)]])])
|
||||
|
||||
(fn enable-shadowing () (set! (word-at (ref :0xc035)) (& (word-at (ref :0xc035)) 0xfff1)))
|
||||
(fn disable-shadowing () (set! (word-at (ref :0xc035)) (| (word-at (ref :0xc035)) 0x000e)))
|
||||
|
@ -94,7 +71,7 @@
|
|||
(when with-shadowing (disable-shadowing))
|
||||
(let (x 0 y 0 screen 0x2000)
|
||||
(while (< y 12)
|
||||
(draw-tile (itile-to-tile (& (+ x y i) 3)) screen)
|
||||
(draw-object screen (itile-to-tile (& (+ x y i) 3)))
|
||||
(set! x (+ x 1))
|
||||
(if (= x 20)
|
||||
(do (set! x 0)
|
||||
|
@ -106,17 +83,17 @@
|
|||
(if (= with-shadowing 1)
|
||||
(let (x 0 y 0 screen 0x2000)
|
||||
(while (< y 12)
|
||||
(shadow-rewrite-tile screen)
|
||||
(draw-object screen pei-slam-tile)
|
||||
(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)))))
|
||||
(let (screen 0x9dff y 0)
|
||||
(let (screen 0x2000 y 0)
|
||||
(while (< y 200)
|
||||
(draw-object screen pei-slam-scanline)
|
||||
(set! screen (- screen 160))
|
||||
(set! screen (+ screen 160))
|
||||
(set! y (+ y 1)))))))
|
||||
|
||||
(fn draw-test-tiles-forever ()
|
||||
|
|
|
@ -8,22 +8,111 @@
|
|||
(local lume (require :lib.lume))
|
||||
(local {: countiter} (require :lib.util))
|
||||
|
||||
; Our bitmap compiler is based on MrSprite - http://brutaldeluxe.fr/products/crossdevtools/mrspritetech/
|
||||
; sprite is a Lua string, where each byte is made up of two nibbles - the low nibble
|
||||
; should be a 16-bit value representing the colour, and the high nibble should be
|
||||
; 0 if the pixel is opaque, or f if the pixel is transparent.
|
||||
; width should be a multiple of 4.
|
||||
(fn preprocess-sprite [sprite w h]
|
||||
; splits up each horizontal line into two kinds of "runs":
|
||||
; :solid - each word can be directly written to memory; there is no transparency
|
||||
; :masked - the word at this location must be bitwise ANDed by :mask and ORed by :word
|
||||
; words containing nothing but transparent pixels are removed.
|
||||
; Also determines the most frequently-occurring solid words and distributes them
|
||||
; to registers.
|
||||
(let [rows [] frequencies {}]
|
||||
(var word 0)
|
||||
(var mask 0)
|
||||
(var isprite 1)
|
||||
(for [y 0 (- h 1)]
|
||||
(let [row []]
|
||||
(var solidrun nil)
|
||||
(for [x 0 (- w 1)]
|
||||
(let [b (string.byte (sprite:sub isprite isprite))
|
||||
pixcolour (bit.band b 0x0f)
|
||||
pixmask (bit.rshift (bit.band b 0xf0) 4)
|
||||
pixshift (match (% x 4) 0 4 1 0 2 12 3 8)]
|
||||
(set word (bit.bor word (bit.lshift pixcolour pixshift)))
|
||||
(set mask (bit.bor mask (bit.lshift pixmask pixshift)))
|
||||
(when (= (% x 4) 3)
|
||||
(when (not= mask 0) (set solidrun nil))
|
||||
(when (= mask 0) ; fully opaque word
|
||||
(when (= solidrun nil)
|
||||
(set solidrun {:run :solid :x (/ (- x 3) 2) :words []})
|
||||
(table.insert row solidrun))
|
||||
(table.insert solidrun.words word)
|
||||
(tset frequencies word (+ (or (. frequencies word) 0) 1)))
|
||||
(when (and (not= mask 0) (not= mask 0xffff))
|
||||
(table.insert row {:run :masked :x (/ (- x 3) 2) : word : mask}))
|
||||
(set word 0)
|
||||
(set mask 0))
|
||||
(set isprite (+ isprite 1))))
|
||||
(table.insert rows row)))
|
||||
(local top-frequencies (icollect [word freq (pairs frequencies)] {: word : freq}))
|
||||
(table.sort top-frequencies #(> $1.freq $2.freq))
|
||||
{: rows
|
||||
:registers {:x (?. top-frequencies 1 :word)
|
||||
:y (?. top-frequencies 2 :word)
|
||||
:d (?. top-frequencies 3 :word)}}))
|
||||
|
||||
(fn compile-row [block row registers]
|
||||
(each [_ run (ipairs row)]
|
||||
(match run.run
|
||||
:solid
|
||||
(let [s-target (+ run.x (* (length run.words) 2) -1)]
|
||||
(lume.push block [:tsc] [:adc (- s-target registers.s)] [:tcs])
|
||||
(set registers.s (- run.x 1))
|
||||
(for [iword (length run.words) 1 -1]
|
||||
(lume.push block
|
||||
(match (. run.words iword)
|
||||
registers.x [:phx]
|
||||
registers.y [:phy]
|
||||
registers.d [:phd]
|
||||
word [:pea word]))))
|
||||
:masked
|
||||
(do (var s-offset (- run.x registers.s))
|
||||
(when (> s-offset 127)
|
||||
(lume.push block [:tsc] [:adc s-offset] [:tcs])
|
||||
(set registers.s run.x)
|
||||
(set s-offset 0))
|
||||
(lume.push block [:lda s-offset :s] [:and run.mask] [:ora run.word] [:sta s-offset :s])))))
|
||||
|
||||
(fn compile-sprite [sprite w h]
|
||||
(let [{: rows : registers} (preprocess-sprite sprite w h)
|
||||
block (lume.concat [:block]
|
||||
(when registers.x [[:ldx registers.x]])
|
||||
(when registers.y [[:ldy registers.y]])
|
||||
(when registers.d [[:lda registers.d] [:tcd]]))]
|
||||
(set registers.s 0)
|
||||
(each [_ row (ipairs rows)]
|
||||
(compile-row block row registers)
|
||||
(set registers.s (- registers.s 160)))
|
||||
block))
|
||||
|
||||
#(compile $1
|
||||
; The fastest way to draw any graphics on the IIgs is to map the stack pointer to
|
||||
; video memory, and use stack-pushing instructions to write values. draw-object
|
||||
; takes a location in video memory and a pointer to a machine code routine called a "drawfn"
|
||||
; that performs the drawing
|
||||
(global word draw-object-saved-stack 0)
|
||||
(fn draw-object (screen object)
|
||||
(asm (sei) ; disable interrupts
|
||||
(lda object) (sta [{:abs #(+ ($1:lookup-addr :draw-object-current-object-jump) 1)}])
|
||||
(tsc) (sta draw-object-saved-stack)
|
||||
(lda screen) (tcs)
|
||||
(lda :0xc068) (ora 0x30) (sta :0xc068) ; set altzp
|
||||
(lda object) (sta [{:abs #(+ ($1:lookup-addr :draw-object-current-object-jump) 1)}]) ; self-modifying code! rewrite the jump target
|
||||
(phd) ; save direct page register
|
||||
(tsc) (sta draw-object-saved-stack) ; save stack
|
||||
(lda screen 2) ; we offset by 2 because we just pushed a word onto the stack and the compiler doesn't know about it
|
||||
(tcs) ; drawfns expect the current screen pointer to be stored in the stack register
|
||||
(lda :0xc068) (ora 0x30) (sta :0xc068) ; move bank 1 to bank 0
|
||||
(clc) ; clear carry - all drawfns will add to the stack pointer and then walk it back
|
||||
draw-object-current-object-jump
|
||||
(jmp draw-object)
|
||||
(jmp draw-object) ; will actually jump to "object"
|
||||
draw-object-finished (export draw-object-finished)
|
||||
(lda :0xc068) (and 0xffcf) (sta :0xc068) ; clear altzp
|
||||
(lda draw-object-saved-stack) (tcs)
|
||||
(lda :0xc068) (and 0xffcf) (sta :0xc068) ; move bank 1 back to bank 1
|
||||
(lda draw-object-saved-stack) (tcs) ; restore the stack pointer
|
||||
(pld) ; restore direct page register
|
||||
(cli))) ; enable interrupts
|
||||
|
||||
(form drawfn [(fn [ssc name ...]
|
||||
(form drawfn [(lambda [ssc name ...]
|
||||
(assert (not (ssc:defining?)) "drawfn must be defined at top level")
|
||||
(set ssc.locals nil) ; locals cannot be used
|
||||
(local asm (ssc:expr-poly (lume.concat [:do ...] [[:asm [:jmp :draw-object-finished]]])))
|
||||
|
@ -33,16 +122,14 @@
|
|||
(ssc.org:append name asm))])
|
||||
|
||||
(drawfn pei-slam-tile
|
||||
(asm (tdc) (tax) ; store direct page register in X
|
||||
(tsc) (sec) (sbc 255) (tcd)
|
||||
(asm (tsc) (tcd) (adc 7) (tcs)
|
||||
[(lume.concat [:block] (icollect [_ (countiter 16)]
|
||||
[(! block (pei (:d0xfe)) (pei (:d0xfc)) (pei (:d0xfa)) (pei (:d0xf8))
|
||||
(tsc) (sbc 152) (tcs) (sbc 255) (tcd))]))]
|
||||
(txa) (tcd))) ; restore direct page register
|
||||
[(! block (pei (:d6)) (pei (:d4)) (pei (:d2)) (pei (:d0))
|
||||
(tsc) (adc 161) (tcd) (adc 7) (tcs))]))]))
|
||||
|
||||
(drawfn pei-slam-scanline
|
||||
(asm (tdc) (tax) ; store direct page register in X
|
||||
(tsc) (sec) (sbc 255) (tcd)
|
||||
[(lume.concat [:block] (icollect [offset (countiter 0xfe (- 0x100 160) -2)] [:pei [(.. :d offset)]]))]
|
||||
(txa) (tcd))) ; restore direct page register
|
||||
(asm (tsc) (tcd) (adc 159) (tcs)
|
||||
[(lume.concat [:block] (icollect [offset (countiter 158 0 -2)] [:pei [(.. :d offset)]]))]))
|
||||
|
||||
(form compile-sprite [(lambda [ssc name sprite w h] (ssc:expr-poly [:drawfn name [:asm (compile-sprite sprite w h)]]))])
|
||||
)
|
||||
|
|
Loading…
Reference in a new issue