From: Andy Wingo <wingo@pobox.com>
Date: Mon, 11 Feb 2013 17:10:22 +0000 (+0100)
Subject: add null-program example
X-Git-Url: http://git.hcoop.net/clinton/guile-figl.git/commitdiff_plain/111cd0a2022ec2f3217e919916547951317ffc70

add null-program example

* Makefile.am: Dist examples and upstream-doc.

* examples/null-program.scm: New example.
---

diff --git a/Makefile.am b/Makefile.am
index 64b93d9..5698518 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -38,7 +38,7 @@ update: figl/parse.go
 update-enums: figl/parse.go
 	$(top_builddir)/env $(GUILE) $(top_srcdir)/maint/update-enumerations
 
-EXTRA_DIST += env.in COPYING COPYING.LESSER
+EXTRA_DIST += env.in COPYING COPYING.LESSER examples upstream-doc
 
 info_TEXINFOS = doc/figl.texi
 figl_TEXINFOS = \
diff --git a/examples/null-program.scm b/examples/null-program.scm
new file mode 100644
index 0000000..b9c830b
--- /dev/null
+++ b/examples/null-program.scm
@@ -0,0 +1,88 @@
+#!/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))))