139 lines
6.7 KiB
Fennel
139 lines
6.7 KiB
Fennel
; IIgs graphical architecture:
|
|
; PREMISE: All small-scale bitmapped graphics are encoded as code that pushes the graphics onto the stack,
|
|
; which has been aligned to the appropriate place to draw said graphics.
|
|
; Jump tables are stored in the main code segment so that eg. tiles can be easily calculated by index, and
|
|
; so we don't have to explicitly pass longs to a regular function.
|
|
|
|
(import-macros {:sss ! : compile} :ssc.macros)
|
|
(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
|
|
(fn enable-shadow-writes () (set! (word-at (ref :0xc035)) (& (word-at (ref :0xc035)) 0xfff1)))
|
|
(fn disable-shadow-writes () (set! (word-at (ref :0xc035)) (| (word-at (ref :0xc035)) 0x000e)))
|
|
|
|
; 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)}]) ; 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) ; will actually jump to "object"
|
|
draw-object-finished (export draw-object-finished)
|
|
(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 [(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]]])))
|
|
(set ssc.locals [])
|
|
(ssc:expr-poly [:form name (fn [ssc] (assert (= ssc.locals nil) (.. name " must be called from a drawfn")) [:jmp name])])
|
|
(ssc:expr-poly [:getter name [:ref name]])
|
|
(ssc.org:append name asm))])
|
|
|
|
(drawfn pei-slam-tile
|
|
(asm (tsc) (tcd) (adc 7) (tcs)
|
|
[(lume.concat [:block] (icollect [_ (countiter 16)]
|
|
[(! block (pei (:d6)) (pei (:d4)) (pei (:d2)) (pei (:d0))
|
|
(tsc) (adc 161) (tcd) (adc 7) (tcs))]))]))
|
|
|
|
(drawfn pei-slam-scanline
|
|
(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)]]))])
|
|
)
|