(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) (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)) 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))))]) (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] [: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-object screen (itile-to-tile (& (+ x y i) 3))) (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) (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 0x2000 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)