honeylisp/neutgs/init.fnl

(local Ssc (require :ssc))
(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)))

  (fn add (lhs rhs) (+ lhs rhs))

  (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)

  (global word screen-offset 0)
  (getter screen-cursor (+ screen-addr screen-offset))
  (setter screen-cursor (pixels)
    (word! screen-cursor pixels)
    (set! screen-offset (+ screen-offset 2)))

  (global word userID)

  (fn print-numbers-forever ()
    (let (i 0) (while true
      (printnum 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)

    (let (number-printer (new-task (ref print-numbers-forever)))
      (wait-for-key)
      (reset-task number-printer (ref yield-forever)))

;     (GrafOff)

    (EMShutDown)
    (QDShutDown)
    (TextShutDown)
    (IMShutDown)
    (MMShutDown userID)))

(ssc:assemble)