diff options
| -rw-r--r-- | 2d/sprite.scm | 383 | ||||
| -rw-r--r-- | data/Makefile.am | 5 | ||||
| -rw-r--r-- | data/shaders/sprite-fragment.glsl | 8 | ||||
| -rw-r--r-- | data/shaders/sprite-vertex.glsl | 26 |
4 files changed, 144 insertions, 278 deletions
diff --git a/2d/sprite.scm b/2d/sprite.scm index 2d6cca0..330c1e8 100644 --- a/2d/sprite.scm +++ b/2d/sprite.scm @@ -31,13 +31,33 @@ #:use-module (2d agenda) #:use-module (2d animation) #:use-module (2d color) + #:use-module (2d config) #:use-module (2d game) #:use-module (2d helpers) #:use-module (2d math) + #:use-module (2d shader) #:use-module (2d signals) #:use-module (2d texture) #:use-module (2d vector2) - #:use-module (2d wrappers gl)) + #:use-module (2d window) + #:use-module (2d wrappers gl) + #:export (make-sprite + sprite? + animated-sprite? + sprite-drawable + sprite-position + set-sprite-drawable! + set-sprite-position! + set-sprite-scale! + set-sprite-rotation! + set-sprite-color! + set-sprite-anchor! + sprite-scale + sprite-rotation + sprite-color + sprite-anchor + load-sprite + draw-sprite)) ;;; ;;; Sprite Vertices @@ -48,74 +68,25 @@ ;; Position (x float) (y float) - ;; Color - (r float) - (g float) - (b float) - (a float) ;; Texture Coordinates (s float) (t float)) (define sprite-vertex-size (packed-struct-size sprite-vertex)) (define x-offset (packed-struct-offset sprite-vertex x)) -(define r-offset (packed-struct-offset sprite-vertex r)) (define s-offset (packed-struct-offset sprite-vertex s)) -(define (pack-sprite-vertices vertices offset x y width height origin-x origin-y - scale-x scale-y rotation s1 t1 s2 t2 color) - (define (pack-sprite x1 y1 x2 y2 x3 y3 x4 y4) - (let ((r (color-r color)) - (g (color-g color)) - (b (color-b color)) - (a (color-a color))) - ;; Vertices go counter clockwise, starting from the top-left - ;; corner. - (pack vertices offset sprite-vertex - x1 y1 - r g b a - s1 t1) - (pack vertices (+ offset 1) sprite-vertex - x2 y2 - r g b a - s1 t2) - (pack vertices (+ offset 2) sprite-vertex - x3 y3 - r g b a - s2 t2) - (pack vertices (+ offset 3) sprite-vertex - x4 y4 - r g b a - s2 t1))) - - (let ((local-x1 (* (- origin-x) scale-x)) - (local-y1 (* (- origin-y) scale-y)) - (local-x2 (* (- width origin-x) scale-x)) - (local-y2 (* (- height origin-y) scale-y))) - (if (= rotation 0) - (begin - (let ((x1 (+ x local-x1)) - (y1 (+ y local-y1)) - (x2 (+ x local-x2)) - (y2 (+ y local-y2))) - (pack-sprite x1 y1 x1 y2 x2 y2 x2 y1))) - (begin - (let* ((sin (sin-degrees rotation)) - (cos (cos-degrees rotation)) - (x1 (+ x (- (* cos local-x1) (* sin local-y1)))) - (y1 (+ y (* sin local-x1) (* cos local-y1))) - (x2 (+ x (- (* cos local-x1) (* sin local-y2)))) - (y2 (+ y (* sin local-x1) (* cos local-y2))) - (x3 (+ x (- (* cos local-x2) (* sin local-y2)))) - (y3 (+ y (* sin local-x2) (* cos local-y2))) - (x4 (+ x1 (- x3 x2))) - (y4 (- y3 (- y2 y1)))) - (pack-sprite x1 y1 x2 y2 x3 y3 x4 y4)))))) +(define (pack-sprite-vertices vertices offset width height s1 t1 s2 t2) + ;; Vertices go counter clockwise, starting from the top-left + ;; corner. + (pack vertices offset sprite-vertex 0 0 s1 t1) + (pack vertices (+ offset 1) sprite-vertex 0 height s1 t2) + (pack vertices (+ offset 2) sprite-vertex width height s2 t2) + (pack vertices (+ offset 3) sprite-vertex width 0 s2 t1)) (define (draw-sprite-vertices texture vertices size) (let ((pointer-type (tex-coord-pointer-type float))) (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 pointer-type @@ -123,172 +94,138 @@ 2 #:stride sprite-vertex-size #:offset x-offset) - (set-gl-color-array pointer-type - vertices - 4 - #:stride sprite-vertex-size - #:offset r-offset) (set-gl-texture-coordinates-array pointer-type vertices #:stride sprite-vertex-size #:offset s-offset) (gl-draw-arrays (begin-mode quads) 0 (* size 4))) (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)))) ;;; ;;; Sprites ;;; +(define sprite-shader + (make-shader-program + (load-vertex-shader (string-append %pkgdatadir + "/shaders/sprite-vertex.glsl")) + (load-fragment-shader (string-append %pkgdatadir + "/shaders/sprite-fragment.glsl")))) + ;; The <sprite> type represents a drawable object (texture, ;; texture-region, animation, etc.) with a given position, scale, ;; rotation, and color. (define-record-type <sprite> - (%make-sprite drawable position scale rotation color anchor - vertices dirty animator) + (%make-sprite drawable position scale rotation color anchor vertices animator) sprite? (drawable sprite-drawable set-sprite-drawable!) - (position sprite-position %set-sprite-position!) - (scale sprite-scale %set-sprite-scale!) - (rotation sprite-rotation %set-sprite-rotation!) - (color sprite-color %set-sprite-color!) + (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!) - (vertices sprite-vertices set-sprite-vertices!) - (dirty sprite-dirty? set-sprite-dirty!) + (vertices sprite-vertices) (animator sprite-animator)) +(define (make-anchor anchor texture) + "Return a vector2 of the coordinates for the center point of a +sprite." + (cond + ((vector2? anchor) + anchor) + ((eq? anchor 'center) + (vector2 (/ (texture-width texture) 2) + (/ (texture-height texture) 2))) + (else + (error "Invalid sprite anchor!" anchor)))) + +(define (update-sprite-vertices! sprite) + (let ((texture (sprite-texture sprite))) + (pack-sprite-vertices (sprite-vertices sprite) + 0 + (texture-width texture) + (texture-height texture) + (texture-s1 texture) + (texture-t1 texture) + (texture-s2 texture) + (texture-t2 texture)))) + (define* (make-sprite drawable #:optional #:key (position (vector2 0 0)) (scale (vector2 1 1)) (rotation 0) (color white) (anchor 'center)) "Create a new sprite object. DRAWABLE is either a texture or -animation object. All keyword arguments are optional. POSITION is a -vector2 object with a default of (0, 0). SCALE is a vector2 object +animation object. All keyword arguments are optional. POSITION is a +vector2 object with a default of (0, 0). SCALE is a vector2 object that describes how much DRAWABLE should be strected on the x and y -axes, with a default of 1x scale. ROTATION is an angle in degrees with -a default of 0. COLOR is a color object with a default of -white. ANCHOR is either a vector2 that represents the center point of -the sprite, or 'center which will place the anchor at the center of -DRAWABLE. Sprites are centered by default." - (let ((vertices (make-packed-array sprite-vertex 4)) +axes, with a default of 1x scale. ROTATION is an angle in degrees +with a default of 0. COLOR is a color object with a default of white. +ANCHOR is either a vector2 that represents the center point of the +sprite, or 'center which will place the anchor at the center of +DRAWABLE. Sprites are centered by default." + (let* ((vertices (make-packed-array sprite-vertex 4)) (animator (if (animation? drawable) (make-animator drawable) - #f))) - (%make-sprite drawable position scale rotation color anchor vertices - #t animator))) - -(define-syntax-rule (dirty-sprite-setter setter private-setter) - "Defines a setter that calls the private version of the given -procedure name (prefix with %) and marks the sprite as dirty. Any -operation that requires a refresh of the vertex array should use this macro." - (define (setter sprite value) - (private-setter sprite value) - (set-sprite-dirty! sprite #t))) - -(dirty-sprite-setter set-sprite-position! %set-sprite-position!) -(dirty-sprite-setter set-sprite-scale! %set-sprite-scale!) -(dirty-sprite-setter set-sprite-rotation! %set-sprite-rotation!) -(dirty-sprite-setter set-sprite-color! %set-sprite-color!) -(dirty-sprite-setter set-sprite-anchor! %set-sprite-anchor!) + #f)) + (anchor (make-anchor anchor (drawable-texture drawable animator))) + (sprite (%make-sprite drawable position scale rotation color + anchor vertices animator))) + (update-sprite-vertices! sprite) + sprite)) (define* (load-sprite filename #:optional #:key (position (vector2 0 0)) (scale (vector2 1 1)) (rotation 0) (color white) (anchor 'center)) "Load a sprite from the file at FILENAME. See make-sprite for optional keyword arguments." - (make-sprite (load-texture filename) #:position position #:scale scale - #:rotation rotation #:color color #:anchor anchor)) + (make-sprite (load-texture filename) + #:position position + #:scale scale + #:rotation rotation + #:color color + #:anchor anchor)) (define (animated-sprite? sprite) "Return #t if SPRITE has an animation as its drawable object." (animation? (sprite-drawable sprite))) -(define (sprite-animation-texture sprite) - (animator-texture (sprite-animator sprite))) +(define (drawable-texture drawable animator) + (cond ((texture? drawable) + drawable) + ((animation? drawable) + (animator-texture animator)))) (define (sprite-texture sprite) "Return the texture for the SPRITE's drawable object." (let ((drawable (sprite-drawable sprite))) - (cond ((texture? drawable) - drawable) - ((animation? drawable) - (sprite-animation-texture sprite))))) + (drawable-texture (sprite-drawable sprite) + (sprite-animator sprite)))) -(define (sprite-anchor-vector sprite) - "Return a vector2 of the coordinates for the center point of a -sprite." - (let ((anchor (sprite-anchor sprite)) - (texture (sprite-texture sprite))) - (cond - ((eq? anchor 'center) - (vector2 (/ (texture-width texture) 2) - (/ (texture-height texture) 2))) - (else anchor)))) - -(define (update-sprite-vertices! sprite) - "Rebuild the internal vertex array." - (let ((pos (signal-ref-maybe (sprite-position sprite))) - (scale (signal-ref-maybe (sprite-scale sprite))) - (anchor (sprite-anchor-vector sprite)) - (texture (sprite-texture sprite))) - (pack-sprite-vertices (sprite-vertices sprite) - 0 - (vx pos) - (vy pos) - (texture-width texture) - (texture-height texture) - (vx anchor) - (vy anchor) - (vx scale) - (vy scale) - (signal-ref-maybe (sprite-rotation sprite)) - (texture-s1 texture) - (texture-t1 texture) - (texture-s2 texture) - (texture-t2 texture) - (sprite-color sprite)))) +(define (set-sprite-anchor! sprite anchor) + (%set-sprite-anchor! sprite (make-anchor anchor (sprite-texture sprite)))) (define (update-sprite-animator! sprite) - (animator-update! (sprite-animator sprite))) + (animator-update! (sprite-animator sprite)) + (update-sprite-vertices! sprite)) (define (draw-sprite sprite) "Render SPRITE to the screen. A sprite batch will be used if one is currently bound." - (when (sprite-dirty? sprite) - (update-sprite-vertices! sprite)) (register-animated-sprite-maybe sprite) - (if *sprite-batch* - (draw-sprite-batched sprite) + (with-shader-program sprite-shader + (uniforms ((position (sprite-position sprite)) + (anchor (sprite-anchor sprite)) + (scale (sprite-scale sprite)) + (rotation (sprite-rotation sprite)) + (color (sprite-color sprite)) + (projection (signal-ref window-projection))) (draw-sprite-vertices (sprite-texture sprite) (sprite-vertices sprite) - 1))) - -(define (draw-sprite-batched sprite) - "Add SPRITE to the current sprite batch batch." - (let ((texture (sprite-texture sprite)) - (pos (signal-ref-maybe (sprite-position sprite))) - (scale (signal-ref-maybe (sprite-scale sprite))) - (anchor (sprite-anchor-vector sprite))) - (register-animated-sprite-maybe sprite) - (%sprite-batch-draw *sprite-batch* - texture - (vx pos) - (vy pos) - (texture-width texture) - (texture-height texture) - (vx anchor) - (vy anchor) - (vx scale) - (vy scale) - (signal-ref-maybe (sprite-rotation sprite)) - (texture-s1 texture) - (texture-t1 texture) - (texture-s2 texture) - (texture-t2 texture) - (sprite-color sprite)))) + 1)))) ;; A hash table for all of the animated sprites that have been drawn -;; since the last game update. It is cleared after every game update. +;; since the last game update. It is cleared after every game-agenda +;; tick. (define animated-sprites (make-hash-table)) (define (register-animated-sprite-maybe sprite) @@ -304,113 +241,3 @@ currently bound." ;; Update animated sprites upon every update. (schedule-each game-agenda update-animated-sprites!) - -(export make-sprite - sprite? - sprite-drawable - set-sprite-drawable! - sprite-position - set-sprite-position! - sprite-scale - set-sprite-scale! - sprite-rotation - set-sprite-rotation! - sprite-color - set-sprite-color! - sprite-anchor - set-sprite-anchor! - sprite-vertices - set-sprite-vertices! - animated-sprite? - load-sprite - draw-sprite) - -;;; -;;; Sprite batches -;;; - -;; Sprite batches allow for efficient texture rendering. Sprites drawn -;; with the same texture are drawn in the same draw call using a -;; vertex array, rather than re-binding the texture for each -;; individual draw call. -(define-record-type <sprite-batch> - (%make-sprite-batch max-size size texture vertices) - sprite-batch? - (max-size sprite-batch-max-size) - (size sprite-batch-size set-sprite-batch-size!) - (texture sprite-batch-texture set-sprite-batch-texture!) - (vertices sprite-batch-vertices)) - -;; Dynamic state for the current sprite batch. -(define *sprite-batch* #f) - -(define* (make-sprite-batch #:optional (max-size 1000)) - "Creates a new sprite batch. The default max-size is 1000." - (let ((vertex-array (make-packed-array sprite-vertex (* 4 max-size)))) - (%make-sprite-batch max-size 0 #f vertex-array))) - -(define (sprite-batch-draw . args) - "Add a textured quad to the current sprite batch. X, Y, WIDTH, and -HEIGHT represent the quad in pixels. ORIGIN-X and ORIGIN-Y represent -the center point of the quad which is used for rotation. SCALE-X and -SCALE-Y are the scaling factors for the x and y axis, -respectively. ROTATION is the angle in degrees to rotate the quad. U, -V, U2, and V2 represent the texture coordinate region to texture the -quad with. COLOR is a color object." - (apply %sprite-batch-draw *sprite-batch* args)) - -(define* (%sprite-batch-draw batch texture x y width height origin-x origin-y - scale-x scale-y rotation u v u2 v2 color) - "Add a textured quad to the sprite batch." - ;; Render the batch when it's full or the texture changes. - (cond ((= (sprite-batch-size batch) (sprite-batch-max-size batch)) - (sprite-batch-render batch)) - ((not (equal? texture (sprite-batch-texture batch))) - (sprite-batch-switch-texture batch texture))) - - ;; Add 4 new vertices, taking into account scaling and rotation. - (pack-sprite-vertices (sprite-batch-vertices batch) - (* 4 (sprite-batch-size batch)) - x y width height origin-x origin-y - scale-x scale-y rotation u v u2 v2 color) - - ;; Increment batch size - (set-sprite-batch-size! batch (1+ (sprite-batch-size batch)))) - -(define (sprite-batch-switch-texture batch texture) - "Change the currently bound texture for BATCH to TEXTURE. This -requires flushing the batched texture vertices first." - (sprite-batch-render batch) - (set-sprite-batch-texture! batch texture)) - -(define (sprite-batch-render batch) - "Render and flushes the currently batched texture vertices within -BATCH." - (unless (= (sprite-batch-size batch) 0) - (draw-sprite-vertices (sprite-batch-texture batch) - (sprite-batch-vertices batch) - (sprite-batch-size batch)) - ;; Reset batch size to 0. - (set-sprite-batch-size! batch 0))) - -;; emacs: (put 'with-sprite-batch 'scheme-indent-function 1) -(define-syntax-rule (with-sprite-batch batch body ...) - (begin - (set! *sprite-batch* batch) - (set-sprite-batch-size! batch 0) - (set-sprite-batch-texture! batch #f) - body - ... - (sprite-batch-render batch) - (set! *sprite-batch* #f))) - -(export make-sprite-batch - sprite-batch? - sprite-batch-max-size - sprite-batch-size - set-sprite-batch-size! - sprite-batch-texture - set-sprite-batch-texture! - sprite-batch-vertices - sprite-batch-draw - with-sprite-batch) diff --git a/data/Makefile.am b/data/Makefile.am index 552da87..b6d0d74 100644 --- a/data/Makefile.am +++ b/data/Makefile.am @@ -1,2 +1,7 @@ fontsdir = $(pkgdatadir)/fonts fonts_DATA = fonts/DejaVuSans.ttf + +shadersdir = $(pkgdatadir)/shaders +shaders_DATA = \ + shaders/sprite-vertex.glsl \ + shaders/sprite-fragment.glsl diff --git a/data/shaders/sprite-fragment.glsl b/data/shaders/sprite-fragment.glsl new file mode 100644 index 0000000..3dd10f1 --- /dev/null +++ b/data/shaders/sprite-fragment.glsl @@ -0,0 +1,8 @@ +#version 120 + +uniform sampler2D color_texture; +uniform vec4 color; + +void main (void) { + gl_FragColor = texture2D(color_texture, gl_TexCoord[0].st) * color; +} diff --git a/data/shaders/sprite-vertex.glsl b/data/shaders/sprite-vertex.glsl new file mode 100644 index 0000000..d6efd3f --- /dev/null +++ b/data/shaders/sprite-vertex.glsl @@ -0,0 +1,26 @@ +#version 120 + +uniform mat4 projection; +uniform vec2 position; +uniform vec2 anchor; +uniform vec2 scale; +uniform float rotation; + +void main(void) { + mat4 rotationMatrix = mat4(cos(rotation), -sin(rotation), 0.0, 0.0, + sin(rotation), cos(rotation), 0.0, 0.0, + 0.0, 0.0, 1.0, 0.0, + 0.0, 0.0, 0.0, 1.0); + mat4 translationMatrix = mat4(1.0, 0.0, 0.0, position.x - anchor.x, + 0.0, 1.0, 0.0, position.y - anchor.y, + 0.0, 0.0, 1.0, 0.0, + 0.0, 0.0, 0.0, 1.0); + mat4 scaleMatrix = mat4(scale.x, 0.0, 0.0, 0.0, + 0.0, scale.y, 0.0, 0.0, + 0.0, 0.0, 1.0, 0.0, + 0.0, 0.0, 0.0, 1.0); + + gl_Position = projection * (gl_Vertex * scaleMatrix * + rotationMatrix * translationMatrix); + gl_TexCoord[0] = gl_MultiTexCoord0; +} |