summaryrefslogtreecommitdiff
path: root/2d/sprite.scm
diff options
context:
space:
mode:
Diffstat (limited to '2d/sprite.scm')
-rw-r--r--2d/sprite.scm136
1 files changed, 104 insertions, 32 deletions
diff --git a/2d/sprite.scm b/2d/sprite.scm
index b8c1472..64a0240 100644
--- a/2d/sprite.scm
+++ b/2d/sprite.scm
@@ -23,6 +23,7 @@
;;; Code:
(define-module (2d sprite)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-42)
#:use-module (figl gl)
@@ -49,7 +50,7 @@
split-texture
make-sprite
sprite?
- sprite-texture
+ sprite-drawable
sprite-position
set-sprite-position!
sprite-scale
@@ -220,12 +221,13 @@ size."
(s float)
(t float))
-;; The <sprite> object represents a texture with a given position, scale,
+;; The <sprite> object represents a drawable object (texture,
+;; texture-region, animation, etc.) with a given position, scale,
;; rotation, and color.
(define-record-type <sprite>
- (%make-sprite texture position scale rotation color anchor vertices)
+ (%make-sprite drawable position scale rotation color anchor vertices)
sprite?
- (texture sprite-texture)
+ (drawable sprite-drawable)
(position sprite-position set-sprite-position!)
(scale sprite-scale set-sprite-scale!)
(rotation sprite-rotation set-sprite-rotation!)
@@ -233,11 +235,11 @@ size."
(anchor sprite-anchor set-sprite-anchor!)
(vertices sprite-vertices set-sprite-vertices!))
-(define* (make-sprite texture #:optional #:key (position #(0 0)) (scale #(1 1))
+(define* (make-sprite drawable #:optional #:key (position #(0 0)) (scale #(1 1))
(rotation 0) (color '(1 1 1)) (anchor 'center))
"Makes a new sprite object."
(let ((vertices (make-packed-array sprite-vertex 4)))
- (%make-sprite texture position scale rotation color anchor vertices)))
+ (%make-sprite drawable 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))
@@ -245,49 +247,119 @@ size."
(make-sprite (load-texture filename) #:position position #:scale scale
#:rotation rotation #:color color #:anchor anchor))
+(define (sprite-texture sprite)
+ "Returns the texture for the sprite's drawable object."
+ (let ((drawable (sprite-drawable sprite)))
+ (cond ((texture? drawable)
+ drawable)
+ ((texture-region? drawable)
+ (texture-region-texture drawable)))))
+
+(define (sprite-texture-coords sprite)
+ "Returns the texture coordinates for the drawable object."
+ (let ((drawable (sprite-drawable sprite)))
+ (cond ((texture? drawable)
+ '(0 0 1 1))
+ ((texture-region? drawable)
+ (list (texture-region-u drawable)
+ (texture-region-v drawable)
+ (texture-region-u2 drawable)
+ (texture-region-v2 drawable))))))
+
+(define (sprite-drawable-size sprite)
+ "Returns the size of the sprite drawable as a vector"
+ (let ((drawable (sprite-drawable sprite)))
+ (cond ((texture? drawable)
+ (vector (texture-width drawable)
+ (texture-height drawable)))
+ ((texture-region? drawable)
+ (vector (texture-region-width drawable)
+ (texture-region-height drawable))))))
+
(define (sprite-anchor-vector sprite)
+ "Returns a vector of the coordinates for the center point of a
+sprite."
(let ((anchor (sprite-anchor sprite)))
(cond
((eq? anchor 'center)
- (let ((texture (sprite-texture sprite)))
- (vector (/ (texture-width texture) 2)
- (/ (texture-height texture) 2))))
+ (let ((size (sprite-drawable-size sprite)))
+ (vector (/ (vx size) 2)
+ (/ (vy size) 2))))
(else anchor))))
(define (update-sprite-vertices sprite)
+ "Rebuilds the internal vertex array."
(let* ((vertices (sprite-vertices sprite))
(texture (sprite-texture sprite))
+ (size (sprite-drawable-size sprite))
(anchor (sprite-anchor-vector sprite))
+ (tex-coords (sprite-texture-coords sprite))
(x (- (vx anchor)))
(y (- (vy anchor)))
- (x2 (+ x (texture-width texture)))
- (y2 (+ y (texture-width texture))))
+ (x2 (+ x (vx size)))
+ (y2 (+ y (vy size)))
+ (u (first tex-coords))
+ (v (second tex-coords))
+ (u2 (third tex-coords))
+ (v2 (fourth tex-coords)))
(pack vertices 0 sprite-vertex
x y
1 1 1 1
- 0 0)
+ u v)
(pack vertices 1 sprite-vertex
x2 y
1 1 1 1
- 1 0)
+ u2 v)
(pack vertices 2 sprite-vertex
x2 y2
1 1 1 1
- 1 1)
+ u2 v2)
(pack vertices 3 sprite-vertex
x y2
1 1 1 1
- 0 1)))
+ u v2)))
(define (draw-sprite sprite)
- "Renders a sprite."
+ "Renders a sprite. A sprite batch will be used if one is currently
+bound."
+ (if *sprite-batch*
+ (draw-sprite-batched sprite)
+ (draw-sprite-vertex-array sprite)))
+
+(define (draw-sprite-batched sprite)
+ "Adds a sprite to the batch."
+ (let ((texture (sprite-texture sprite))
+ (pos (sprite-position sprite))
+ (size (sprite-drawable-size sprite))
+ (scale (sprite-scale sprite))
+ (anchor (sprite-anchor-vector sprite))
+ (tex-coords (sprite-texture-coords sprite)))
+ (%sprite-batch-draw *sprite-batch*
+ texture
+ (- (vx pos) (vx anchor))
+ (- (vy pos) (vy anchor))
+ (vx size)
+ (vy size)
+ #:rotation (sprite-rotation sprite)
+ #:scale-x (vx scale)
+ #:scale-y (vy scale)
+ #:u (first tex-coords)
+ #:v (second tex-coords)
+ #:u2 (third tex-coords)
+ #:v2 (fourth tex-coords))))
+
+(define (draw-sprite-vertex-array sprite)
+ "Renders a sprite using its internal vertex array."
(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))
- (vertices (sprite-vertices sprite)))
+ (vertices (sprite-vertices sprite))
+ (struct-size (packed-struct-size sprite-vertex))
+ (x-offset (packed-struct-offset sprite-vertex x))
+ (r-offset (packed-struct-offset sprite-vertex r))
+ (s-offset (packed-struct-offset sprite-vertex s))
+ (pointer-type (tex-coord-pointer-type float)))
(with-gl-push-matrix
(gl-translate (vx pos) (vy pos) 0)
(gl-rotate (sprite-rotation sprite) 0 0 1)
@@ -297,21 +369,23 @@ size."
(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)
+ (set-gl-vertex-array pointer-type
vertices
2
- #:stride (packed-struct-size sprite-vertex)
- #:offset (packed-struct-offset sprite-vertex x))
- (set-gl-color-array (color-pointer-type float)
+ #:stride struct-size
+ #:offset x-offset)
+ (set-gl-color-array pointer-type
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)
+ #:stride struct-size
+ #:offset r-offset)
+ (set-gl-texture-coordinates-array pointer-type
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)))
+ #:stride struct-size
+ #:offset s-offset)
+ (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)))))
@@ -344,7 +418,7 @@ size."
(apply %sprite-batch-draw *sprite-batch* args))
(define* (%sprite-batch-draw batch texture x y width height
- #:optional #:key (center-x 0) (center-y 0)
+ #:optional #:key
(scale-x 1) (scale-y 1) (rotation 0)
(u 0) (v 0) (u2 1) (v2 1))
"Adds a textured quad to the sprite batch."
@@ -356,8 +430,6 @@ size."
;; Add 4 new vertices.
(let ((base (* 4 (sprite-batch-size batch)))
(vertices (sprite-batch-vertices batch))
- (x (- x center-x))
- (y (- y center-y))
(x2 (+ x width))
(y2 (+ y height)))
(pack vertices base sprite-vertex