honeylisp/neutgs/init.fnl

105 lines
2.5 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)
(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 addr)
(asm
(lda 16) (sta [ssc.LONG_LO]) (clc)
(lda tile) (tax) (lda addr) (tay)
(bra draw)
loop
(tya) (adc 152) (tay)
draw
(lda 7) (mvn 0 0xe1)
(dec [ssc.LONG_LO]) (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 0x2000)
(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)
(ClearScreen 0)
(set-palette 0 [pal])
(SetAllSCBs 0)
(wait-for-key)
(draw-test-tiles)
(wait-for-key)
(GrafOff)
(EMShutDown)
(QDShutDown)
(TextShutDown)
(IMShutDown)
(MMShutDown userID)))
(ssc:assemble)