(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) (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 (bytes [(. files.game.tiles 1 :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 (long addr)) (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) (fn print-numbers-forever () (let (i 0) (while true (printnum i) (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)) (IMStartUp) (TextStartUp) (QDStartUp 0x2100 0 0 userID) (EMStartUp 0x2000 0 0 320 0 200 userID) (GrafOn) (set-palette 0 [pal]) (SetAllSCBs 0) (draw-test-tiles) (wait-for-key) (GrafOff) (EMShutDown) (QDShutDown) (TextShutDown) (IMShutDown) (MMShutDown userID))) (ssc:assemble)