From 17a61d9d0c5675a1b5bf8a3abac15c62a0eb1181 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@member.fsf.org>
Date: Mon, 24 Jun 2013 21:03:57 -0400
Subject: Add some rough example programs.

---
 examples/bullet.png    | Bin 0 -> 1279 bytes
 examples/particles.scm |  93 +++++++++++++++++++++++++++++++++++++++++++++++++
 examples/simple.scm    |  36 +++++++++++++++++++
 examples/sprite.png    | Bin 0 -> 15176 bytes
 examples/stars.png     | Bin 0 -> 82047 bytes
 5 files changed, 129 insertions(+)
 create mode 100644 examples/bullet.png
 create mode 100644 examples/particles.scm
 create mode 100644 examples/simple.scm
 create mode 100644 examples/sprite.png
 create mode 100644 examples/stars.png

(limited to 'examples')

diff --git a/examples/bullet.png b/examples/bullet.png
new file mode 100644
index 0000000..6b141d6
Binary files /dev/null and b/examples/bullet.png differ
diff --git a/examples/particles.scm b/examples/particles.scm
new file mode 100644
index 0000000..28420b6
--- /dev/null
+++ b/examples/particles.scm
@@ -0,0 +1,93 @@
+;; load the SDL module and some useful srfi's
+(use-modules ((sdl sdl) #:prefix SDL:)
+             (figl gl)
+             (srfi srfi-1)
+             (srfi srfi-2)
+             (srfi srfi-9)
+             (ice-9 format)
+             (2d texture)
+             (2d sprite)
+             (2d game-loop)
+             (2d window)
+             (2d vector))
+
+(set! *random-state* (random-state-from-platform))
+
+;;;
+;;; Particles
+;;;
+
+(define-record-type <particle>
+  (make-particle sprite position velocity)
+  particle?
+  (sprite particle-sprite)
+  (position particle-position set-particle-position!)
+  (velocity particle-velocity set-particle-velocity!))
+
+(define (draw-particle particle)
+  (let* ((texture (sprite-texture (particle-sprite particle)))
+         (p (particle-position particle))
+         (x (vx p))
+         (y (vy p))
+         (x2 (+ x (texture-width texture)))
+         (y2 (+ y (texture-height texture))))
+    (gl-texture-coordinates 0 0)
+    (gl-vertex x y)
+    (gl-texture-coordinates 1 0)
+    (gl-vertex x2 y)
+    (gl-texture-coordinates 1 1)
+    (gl-vertex x2 y2)
+    (gl-texture-coordinates 0 1)
+    (gl-vertex x y2)))
+
+(define (draw-particles particles)
+  (let ((texture (sprite-texture (particle-sprite (car particles)))))
+    (with-gl-bind-texture (texture-target texture-2d) (texture-id texture)
+      (gl-begin (begin-mode quads)
+        (gl-color 1 1 1)
+        (for-each (lambda (p) (draw-particle p)) particles)))))
+
+(define (update-particle! particle)
+  (set-particle-position! particle
+                          (v+ (particle-position particle)
+                              (particle-velocity particle))))
+
+;;;
+;;; Demo
+;;;
+
+(define window-width 800)
+(define window-height 600)
+
+(open-window window-width window-height)
+
+(define stars (load-sprite "stars.png" #:anchor #(0 0)))
+(define particle-image (load-texture "bullet.png"))
+(define num-particles 300)
+(define particles
+  (list-tabulate num-particles
+                 (lambda (n)
+                   (make-particle (make-sprite particle-image)
+                                  (vector (random window-width)
+                                          (random window-height))
+                                  (vector (* (random:normal) 1)
+                                           (* (random:normal) 1))))))
+
+(set-render-callback (lambda () (render)))
+(set-update-callback (lambda () (update)))
+(set-key-down-callback (lambda (key) (key-down key)))
+
+(define (key-down key)
+  (case key
+    ((SDLK_ESCAPE SDLK_q)
+     (close-window)
+     (quit))))
+
+(define (render)
+  (draw-sprite stars)
+  (draw-particles particles))
+
+(define (update)
+  (for-each update-particle! particles))
+
+(run-game-loop)
diff --git a/examples/simple.scm b/examples/simple.scm
new file mode 100644
index 0000000..f9ee142
--- /dev/null
+++ b/examples/simple.scm
@@ -0,0 +1,36 @@
+(use-modules ((sdl sdl) #:prefix SDL:)
+             (figl gl)
+             (2d sprite)
+             (2d game-loop)
+             (2d window)
+             (2d vector))
+
+(define window-width 800)
+(define window-height 600)
+(define sprite #f)
+
+(define (key-down key)
+  (case key
+    ;; Quit program when ESCAPE or Q is pressed.
+    ((SDLK_ESCAPE SDLK_q)
+     (close-window)
+     (quit))))
+
+(define (render)
+  (draw-sprite sprite))
+
+;; Register callbacks.
+(set-render-callback (lambda () (render)))
+(set-key-down-callback (lambda (key) (key-down key)))
+
+;; Open the window.
+(open-window window-width window-height)
+
+;; Load a sprite.
+;; Must be done AFTER opening the window.
+(set! sprite (load-sprite "sprite.png" #:position (vector (/ window-width 2)
+                                                          (/ window-height 2))))
+
+;; Start the game loop.
+;; The render callback will be called through this procedure.
+(run-game-loop)
diff --git a/examples/sprite.png b/examples/sprite.png
new file mode 100644
index 0000000..2b2c6da
Binary files /dev/null and b/examples/sprite.png differ
diff --git a/examples/stars.png b/examples/stars.png
new file mode 100644
index 0000000..e9b89d4
Binary files /dev/null and b/examples/stars.png differ
-- 
cgit v1.2.3