summaryrefslogtreecommitdiff
path: root/2d
diff options
context:
space:
mode:
Diffstat (limited to '2d')
-rw-r--r--2d/sprite.scm103
1 files changed, 84 insertions, 19 deletions
diff --git a/2d/sprite.scm b/2d/sprite.scm
index b15ad32..e7c0259 100644
--- a/2d/sprite.scm
+++ b/2d/sprite.scm
@@ -24,6 +24,7 @@
(define-module (2d sprite)
#:use-module (srfi srfi-9)
#:use-module (figl gl)
+ #:use-module (figl contrib packed-struct)
#:use-module (2d texture)
#:use-module (2d vector)
#:export (make-sprite
@@ -35,35 +36,46 @@
set-sprite-scale!
sprite-rotation
set-sprite-rotation!
- set-sprite-scale!
+ sprite-color
+ set-sprite-color!
+ sprite-anchor
+ set-sprite-anchor!
+ sprite-vertices
+ set-sprite-vertices!
load-sprite
draw-sprite))
+;; Used to build OpenGL vertex array for a sprite.
+(define-packed-struct sprite-vertex
+ (x float)
+ (y float)
+
+ (r float)
+ (g float)
+ (b float)
+ (a float)
+
+ (s float)
+ (t float))
+
;; The <sprite> object represents a texture with a given position, scale,
;; rotation, and color.
(define-record-type <sprite>
- (%make-sprite texture position scale rotation color anchor)
+ (%make-sprite texture position scale rotation color anchor vertices)
sprite?
(texture sprite-texture)
(position sprite-position set-sprite-position!)
(scale sprite-scale set-sprite-scale!)
(rotation sprite-rotation set-sprite-rotation!)
(color sprite-color set-sprite-color!)
- (anchor sprite-anchor set-sprite-anchor))
-
-(define (sprite-anchor-vector sprite)
- (let ((anchor (sprite-anchor sprite)))
- (cond
- ((eq? anchor 'center)
- (let ((texture (sprite-texture sprite)))
- (vector (/ (texture-width texture) 2)
- (/ (texture-height texture) 2))))
- (else anchor))))
+ (anchor sprite-anchor set-sprite-anchor!)
+ (vertices sprite-vertices set-sprite-vertices!))
(define* (make-sprite texture #:optional #:key (position #(0 0)) (scale #(1 1))
(rotation 0) (color '(1 1 1)) (anchor 'center))
"Makes a new sprite object."
- (%make-sprite texture position scale rotation color anchor))
+ (let ((vertices (make-packed-array sprite-vertex 4)))
+ (%make-sprite texture position scale rotation color anchor vertices)))
(define* (load-sprite filename #:optional #:key (position #(0 0)) (scale #(1 1))
(rotation 0) (color '(1 1 1)) (anchor 'center))
@@ -71,20 +83,73 @@
(make-sprite (load-texture filename) #:position position #:scale scale
#:rotation rotation #:color color #:anchor anchor))
+(define (sprite-anchor-vector sprite)
+ (let ((anchor (sprite-anchor sprite)))
+ (cond
+ ((eq? anchor 'center)
+ (let ((texture (sprite-texture sprite)))
+ (vector (/ (texture-width texture) 2)
+ (/ (texture-height texture) 2))))
+ (else anchor))))
+
+(define (update-sprite-vertices sprite)
+ (let* ((vertices (sprite-vertices sprite))
+ (texture (sprite-texture sprite))
+ (anchor (sprite-anchor-vector sprite))
+ (x (- (vx anchor)))
+ (y (- (vy anchor)))
+ (x2 (+ x (texture-width texture)))
+ (y2 (+ y (texture-width texture))))
+ (pack vertices 0 sprite-vertex
+ x y
+ 1 1 1 1
+ 0 0)
+ (pack vertices 1 sprite-vertex
+ x2 y
+ 1 1 1 1
+ 1 0)
+ (pack vertices 2 sprite-vertex
+ x2 y2
+ 1 1 1 1
+ 1 1)
+ (pack vertices 3 sprite-vertex
+ x y2
+ 1 1 1 1
+ 0 1)))
+
(define (draw-sprite sprite)
"Renders a sprite."
+ (update-sprite-vertices sprite)
(let* ((texture (sprite-texture sprite))
(width (texture-width texture))
(height (texture-height texture))
(pos (sprite-position sprite))
(scale (sprite-scale sprite))
- (anchor (sprite-anchor-vector sprite)))
+ (vertices (sprite-vertices sprite)))
(with-gl-push-matrix
(gl-translate (vx pos) (vy pos) 0)
(gl-rotate (sprite-rotation sprite) 0 0 1)
(gl-scale (vx scale) (vy scale) 0)
- ;; Render a textured quad center on the sprite position.
- (texture-quad texture
- (- (vx anchor)) (- (vy anchor))
- width height
- (sprite-color sprite)))))
+ ;; Draw vertex array
+ (gl-enable-client-state (enable-cap vertex-array))
+ (gl-enable-client-state (enable-cap color-array))
+ (gl-enable-client-state (enable-cap texture-coord-array))
+ (with-gl-bind-texture (texture-target texture-2d) (texture-id texture)
+ (set-gl-vertex-array (vertex-pointer-type float)
+ vertices
+ 2
+ #:stride (packed-struct-size sprite-vertex)
+ #:offset (packed-struct-offset sprite-vertex x))
+ (set-gl-color-array (color-pointer-type float)
+ vertices
+ 4
+ #:stride (packed-struct-size sprite-vertex)
+ #:offset (packed-struct-offset sprite-vertex r))
+ (set-gl-texture-coordinates-array (tex-coord-pointer-type float)
+ vertices
+ #:stride (packed-struct-size sprite-vertex)
+ #:offset (packed-struct-offset sprite-vertex s))
+ (gl-draw-arrays (begin-mode quads) 0 (packed-array-length vertices sprite-vertex)))
+ (gl-disable-client-state (enable-cap texture-coord-array))
+ (gl-disable-client-state (enable-cap color-array))
+ (gl-disable-client-state (enable-cap vertex-array)))))