summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--examples/bullet.pngbin0 -> 1279 bytes
-rw-r--r--examples/particles.scm93
-rw-r--r--examples/simple.scm36
-rw-r--r--examples/sprite.pngbin0 -> 15176 bytes
-rw-r--r--examples/stars.pngbin0 -> 82047 bytes
5 files changed, 129 insertions, 0 deletions
diff --git a/examples/bullet.png b/examples/bullet.png
new file mode 100644
index 0000000..6b141d6
--- /dev/null
+++ b/examples/bullet.png
Binary files 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
--- /dev/null
+++ b/examples/sprite.png
Binary files differ
diff --git a/examples/stars.png b/examples/stars.png
new file mode 100644
index 0000000..e9b89d4
--- /dev/null
+++ b/examples/stars.png
Binary files differ