summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--sly/sprite.scm165
1 files changed, 23 insertions, 142 deletions
diff --git a/sly/sprite.scm b/sly/sprite.scm
index c8e0fe4..9427373 100644
--- a/sly/sprite.scm
+++ b/sly/sprite.scm
@@ -29,36 +29,13 @@
#:use-module (gl)
#:use-module (gl contrib packed-struct)
#:use-module ((sdl sdl) #:prefix SDL:)
- #:use-module (sly agenda)
- #:use-module (sly animation)
- #:use-module (sly color)
#:use-module (sly config)
- #:use-module (sly helpers)
#:use-module (sly math)
+ #:use-module (sly mesh)
#:use-module (sly shader)
- #:use-module (sly signal)
#:use-module (sly texture)
- #:use-module (sly vector)
- #:use-module (sly window)
- #:use-module (sly wrappers gl)
#:export (enable-sprites
- make-sprite
- sprite?
- animated-sprite?
- sprite-drawable
- sprite-position
- sprite-scale
- sprite-rotation
- sprite-color
- sprite-anchor
- set-sprite-drawable
- set-sprite-position
- set-sprite-scale
- set-sprite-rotation
- set-sprite-color
- set-sprite-anchor
- load-sprite
- draw-sprite))
+ make-sprite))
;;;
;;; Sprites
@@ -74,120 +51,24 @@
(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-immutable-record-type <sprite>
- (%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)
- (anchor sprite-anchor set-sprite-anchor)
- (vertices sprite-vertices)
- (animator sprite-animator))
-
-(define sprite-position (compose signal-ref-maybe %sprite-position))
-(define sprite-scale (compose signal-ref-maybe %sprite-scale))
-(define sprite-rotation (compose signal-ref-maybe %sprite-rotation))
-(define sprite-color (compose signal-ref-maybe %sprite-color))
-
-(define (update-sprite-vertices! sprite)
- (let ((texture (sprite-texture sprite)))
- (pack-texture-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 #(0 0)) (scale #(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
-vector with a default of (0, 0). SCALE is a vector 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
-vector 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 texture-vertex 4))
- (animator (if (animation? drawable)
- (make-animator drawable)
- #f))
- (anchor (anchor-texture (drawable-texture drawable animator) anchor))
- (sprite (%make-sprite drawable position scale rotation color
- anchor vertices animator)))
- (update-sprite-vertices! sprite)
- sprite))
-
-(define* (load-sprite filename #:optional #:key
- (position #(0 0)) (scale #(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))
-
-(define (animated-sprite? sprite)
- "Return #t if SPRITE has an animation as its drawable object."
- (animation? (sprite-drawable 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)))
- (drawable-texture (sprite-drawable sprite)
- (sprite-animator sprite))))
-
-(define (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."
- (register-animated-sprite-maybe 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-texture-vertices (sprite-texture sprite)
- (sprite-vertices 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 agenda tick.
-(define animated-sprites (make-hash-table))
-
-(define (register-animated-sprite-maybe sprite)
- (when (animated-sprite? sprite)
- (hash-set! animated-sprites sprite sprite)))
-
-(define (update-animated-sprites!)
- "Update all animators for sprites that have been drawn this frame."
- (hash-for-each (lambda (key val)
- (update-sprite-animator! val))
- animated-sprites)
- (hash-clear! animated-sprites))
-
-;; Update animated sprites upon every update.
-(schedule-each update-animated-sprites!)
+(define (make-sprite texture shader)
+ (let* ((half-width (half (texture-width texture)))
+ (half-height (half (texture-height texture)))
+ (s1 (texture-s1 texture))
+ (t1 (texture-t1 texture))
+ (s2 (texture-s2 texture))
+ (t2 (texture-t2 texture)))
+ (make-mesh
+ #:shader shader
+ #:texture texture
+ #:indices #(0 3 2 0 2 1)
+ #:data `(("position" ,(vector
+ (vector (- half-width) (- half-height) 0)
+ (vector half-width (- half-height) 0)
+ (vector half-width half-height 0)
+ (vector (- half-width) half-height 0)))
+ ("tex" ,(vector
+ (vector s1 t1)
+ (vector s2 t1)
+ (vector s2 t2)
+ (vector s1 t2)))))))