Jeremy Penner
d2ff69258f
asm: allow computed addresses, not just immediate mode values map llissp source to assembly
161 lines
4.3 KiB
Fennel
161 lines
4.3 KiB
Fennel
(local Ssc (require :ssc))
|
|
(local files (require :game.files))
|
|
(local {: pal} (require :editor.tiledraw.iigs))
|
|
(import-macros {:sss ! : compile} :ssc.macros)
|
|
|
|
(local ssc (Ssc))
|
|
(compile ssc
|
|
(require ssc.iigs.bootstub)
|
|
(require ssc.iigs.toolbox)
|
|
(require ssc.iigs.graphics)
|
|
|
|
(tooltable toolsets
|
|
ToolsetIntegerMath 0x0100
|
|
ToolsetText 0x0100
|
|
ToolsetQuickDraw 0x0100
|
|
ToolsetEventManager 0x0100
|
|
5 0x0100 ; desk manager
|
|
9 0x0100) ; ADB
|
|
|
|
(asm pascalhex (db 5) hexbuf (bytes " "))
|
|
|
|
(fn printnum (num)
|
|
(long! (ref hexbuf) (HexIt num))
|
|
(WriteString (far-ref pascalhex)))
|
|
|
|
(asm event-buffer)
|
|
(global word event-what)
|
|
(global long event-msg)
|
|
(global long event-when)
|
|
(global word event-y)
|
|
(global word event-x)
|
|
(global word event-mod)
|
|
|
|
(fn wait-for-key ()
|
|
(FlushEvents keyDownMask 0)
|
|
(while (not (GetNextEvent keyDownMask (far-ref event-buffer)))
|
|
(yield)))
|
|
|
|
(const screen-addr 0xe12000)
|
|
(const screen-size 0x9d00)
|
|
|
|
(asm tiles [(lume.concat [:flatten] (icollect [_ tile (ipairs files.game.tiles)] [:bytes tile.gfx]))])
|
|
|
|
(form set-palette [(fn [ssc index pal]
|
|
(let [addr (+ 0xe19e00 (* index 0x20))
|
|
writes (icollect [icolor [r g b] (ipairs pal)]
|
|
[[: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 ()
|
|
(let (i 0) (while true
|
|
(printnum i)
|
|
(yield)
|
|
(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)]])])
|
|
|
|
(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)))
|
|
|
|
(global word with-shadowing 0)
|
|
|
|
(fn draw-test-tiles (i)
|
|
(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)
|
|
(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)))))
|
|
(when with-shadowing
|
|
(enable-shadowing)
|
|
(if (= with-shadowing 1)
|
|
(let (x 0 y 0 screen 0x2000)
|
|
(while (< y 12)
|
|
(shadow-rewrite-tile 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)))))
|
|
(let (screen 0x9dff y 0)
|
|
(while (< y 200)
|
|
(draw-object screen pei-slam-scanline)
|
|
(set! screen (- screen 160))
|
|
(set! y (+ y 1)))))))
|
|
|
|
(fn draw-test-tiles-forever ()
|
|
(let (i 0)
|
|
(while true
|
|
(draw-test-tiles i)
|
|
(yield)
|
|
(set! i (+ i 1)))))
|
|
|
|
(fn main ()
|
|
(LoadTools (far-ref toolsets))
|
|
(set! userID (MMStartUp))
|
|
(IMStartUp)
|
|
(TextStartUp)
|
|
(QDStartUp 0x2100 0 0 userID)
|
|
(EMStartUp 0x2000 0 0 320 0 200 userID)
|
|
(GrafOn)
|
|
(ClearScreen 0)
|
|
(set-palette 0 [pal])
|
|
(SetAllSCBs 0)
|
|
|
|
(wait-for-key)
|
|
(enable-shadowing)
|
|
(let (tile-task (new-task (ref draw-test-tiles-forever)))
|
|
(wait-for-key)
|
|
(set! with-shadowing 1)
|
|
(wait-for-key)
|
|
(set! with-shadowing 2)
|
|
(wait-for-key)
|
|
(set! with-shadowing false)
|
|
(reset-task tile-task (ref yield-forever)))
|
|
|
|
(GrafOff)
|
|
|
|
(EMShutDown)
|
|
(QDShutDown)
|
|
(TextShutDown)
|
|
(IMShutDown)
|
|
(MMShutDown userID)))
|
|
|
|
(ssc:assemble)
|