diff options
| -rw-r--r-- | 2d/sprite.scm | 136 |
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 |