--- /dev/null
+#!/usr/bin/env guile
+!#
+
+;; This is the null OpenGL program. Run as guile --listen
+;; null-program.scm to build it out at runtime.
+
+(use-modules (figl glut)
+ (figl gl))
+
+(define main-window #f)
+
+(define accumulate-fps!
+ (let ((frame-count 0)
+ (last-time (get-internal-real-time))
+ (last-frame-count 0))
+ (lambda ()
+ (let ((now (get-internal-real-time)))
+ (set! frame-count (1+ frame-count))
+ (when (> (- now last-time)
+ (* 2 internal-time-units-per-second))
+ (format (current-error-port)
+ ";;; fps: ~a\n"
+ (/ (- frame-count last-frame-count)
+ (/ (- now last-time)
+ (exact->inexact internal-time-units-per-second))))
+ (set! last-frame-count frame-count)
+ (set! last-time now))))))
+
+(define (on-display)
+ (accumulate-fps!)
+ (gl-clear (clear-buffer-mask color-buffer depth-buffer))
+
+ ;; Draw here!
+
+ ;; With double-buffering, swap-buffers will wait for the frame rate.
+ (swap-buffers))
+
+(define (on-reshape width height)
+ (pk 'reshape width height))
+
+(define (on-keyboard keycode x y)
+ (let ((c (integer->char keycode)))
+ (case c
+ ((#\esc #\etx #\q)
+ (format #t "~s pressed; quitting.\n" c)
+ (exit))
+ (else
+ (pk 'keyboard c x y)))))
+
+;; Like keyboard, but for special keys.
+(define (on-special keycode x y)
+ (pk 'special keycode x y))
+
+(define (on-mouse button state x y)
+ (pk 'mouse button state x y))
+
+;; Called when a button is down. Set a passive-motion-callback if you
+;; want motion when no button is down.
+(define (on-motion x y)
+ (pk 'motion x y))
+
+(define (on-visibility visible?)
+ (pk 'visible visible?))
+
+(define (on-idle)
+ ;; Update the world here!
+
+ (post-redisplay main-window))
+
+(define (main args)
+ (initialize-glut args
+ #:window-size '(320 . 200)
+ #:display-mode (display-mode rgb double depth))
+ (set! main-window (make-window "glut"))
+ ;; The trampolines allow the handlers to be overridden at runtime by
+ ;; an attached Guile REPL client.
+ (set-display-callback (lambda () (on-display)))
+ (set-reshape-callback (lambda (w h) (on-reshape w h)))
+ (set-keyboard-callback (lambda (k x y) (on-keyboard k x y)))
+ (set-special-callback (lambda (k x y) (on-special k x y)))
+ (set-mouse-callback (lambda (b s x y) (on-mouse b s x y)))
+ (set-motion-callback (lambda (x y) (on-motion x y)))
+ (set-visibility-callback (lambda (visible?) (on-visibility visible?)))
+ (set-idle-callback (lambda () (on-idle)))
+ (glut-main-loop))
+
+(when (batch-mode?)
+ (exit (main (program-arguments))))