honeylisp/neutgs/init.fnl

141 lines
3.9 KiB
Plaintext
Raw Normal View History

(local Ssc (require :ssc))
2021-09-02 02:59:55 +00:00
(local files (require :game.files))
(local {: pal} (require :editor.tiledraw.iigs))
(import-macros {:sss ! : compile} :ssc.macros)
2021-08-20 03:51:12 +00:00
(local ssc (Ssc))
(compile ssc
2021-08-20 03:51:12 +00:00
(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
(buffer hexbuf (cstr " "))
(fn printnum (num)
2021-08-09 18:43:24 +00:00
(long! (ref hexbuf) (HexIt num))
(WriteCString (far-ref hexbuf)))
(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)
2021-08-20 03:51:12 +00:00
(while (not (GetNextEvent keyDownMask (far-ref event-buffer)))
(yield)))
(define screen-addr 0xe12000)
(define 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))
2021-09-02 02:59:55 +00:00
(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)
2021-08-20 03:51:12 +00:00
(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)]])])
(global word with-shadowing 0)
2021-09-07 03:23:45 +00:00
(fn draw-test-tiles (i)
2021-09-14 03:16:03 +00:00
(when with-shadowing (disable-shadow-writes))
(let (x 0 y 0 screen 0x2000)
2021-09-14 03:16:03 +00:00
(while (< y 37)
(let (tile (itile-to-tile (& (+ x y i) 3)))
(draw-object screen tile))
(set! x (+ x 1))
(if (= x 20)
2021-09-14 03:16:03 +00:00
(do (set! y (+ y 1))
(set! x (if (& y 1) 1 0))
(set! screen (+ screen [(+ 12 (* 160 4))])))
(set! screen (+ screen 8)))))
(when with-shadowing
2021-09-14 03:16:03 +00:00
(enable-shadow-writes)
(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)))))))
2021-09-07 03:23:45 +00:00
(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)
2021-09-02 02:59:55 +00:00
(GrafOn)
(ClearScreen 0)
2021-09-14 03:16:03 +00:00
(let (screen 0x12000) (while (< screen 0x1a000)
(word! screen 0)
(set! screen (+ screen 2))))
2021-09-02 02:59:55 +00:00
(set-palette 0 [pal])
(SetAllSCBs 0)
2021-09-14 03:16:03 +00:00
(enable-shadow-writes)
(draw-test-tiles 0)
(wait-for-key)
2021-09-07 03:23:45 +00:00
(let (tile-task (new-task (ref draw-test-tiles-forever)))
(wait-for-key)
(set! with-shadowing 1)
(wait-for-key)
(set! with-shadowing 2)
2021-09-07 03:23:45 +00:00
(wait-for-key)
(set! with-shadowing false)
2021-09-14 03:16:03 +00:00
(reset-task tile-task (ref yield-forever))
(wait-for-key))
2021-08-20 03:51:12 +00:00
2021-09-02 02:59:55 +00:00
(GrafOff)
(EMShutDown)
(QDShutDown)
(TextShutDown)
(IMShutDown)
(MMShutDown userID)))
(ssc:assemble)