summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/render/texture.scm73
1 files changed, 72 insertions, 1 deletions
diff --git a/chickadee/render/texture.scm b/chickadee/render/texture.scm
index ef55dca..086caab 100644
--- a/chickadee/render/texture.scm
+++ b/chickadee/render/texture.scm
@@ -28,6 +28,7 @@
#:use-module ((sdl2 image) #:prefix sdl-image:)
#:use-module (sdl2 surface)
#:use-module (oop goops)
+ #:use-module (chickadee math rect)
#:use-module (chickadee render gl)
#:use-module (chickadee render gpu)
#:export (make-texture
@@ -43,8 +44,15 @@
texture-wrap-s
texture-wrap-t
null-texture
- *texture-state*))
+ *texture-state*
+ texture-atlas
+ list->texture-atlas
+ split-texture
+ texture-atlas?
+ texture-atlas-ref))
+
+
;;;
;;; Textures
;;;
@@ -189,3 +197,66 @@ magnification. Valid values are 'nearest and 'linear. By default,
(call-with-surface (sdl-image:load-image file)
(lambda (surface)
(surface->texture surface min-filter mag-filter wrap-s wrap-t))))
+
+
+;;;
+;;; Texture Atlas
+;;;
+
+(define-record-type <texture-atlas>
+ (%make-texture-atlas texture vector)
+ texture-atlas?
+ (texture texture-atlas-texture)
+ (vector texture-atlas-vector))
+
+(define (list->texture-atlas texture rects)
+ "Return a new atlas for TEXTURE containing RECTS, a list of texture
+coordinate rects denoting the various tiles within."
+ (let ((v (make-vector (length rects))))
+ (let loop ((i 0)
+ (rects rects))
+ (match rects
+ (() (%make-texture-atlas texture v))
+ ((r . rest)
+ (vector-set! v i r)
+ (loop (1+ i) rest))))))
+
+(define (texture-atlas texture . rects)
+ "Return a new atlas for TEXTURE containing RECTS, a series of
+texture coordinate rect arguments denoting the various tiles within."
+ (list->texture-atlas texture rects))
+
+(define (texture-atlas-ref atlas index)
+ "Return the texture coordinate rect associated with INDEX in
+ATLAS."
+ (vector-ref (texture-atlas-vector atlas) index))
+
+(define* (split-texture texture tile-width tile-height #:key
+ (margin 0) (spacing 0))
+ "Return a new texture atlas that splits TEXTURE into a grid of
+TILE-WIDTH by TILE-HEIGHT rectangles. Optionally, each tile may have
+SPACING pixels of horizontal and vertical space between surrounding
+tiles and the entire image may have MARGIN pixels of empty space
+around its border.
+
+This type of texture atlas layout is very common for tile map
+terrain."
+ (let* ((w (texture-width texture))
+ (h (texture-height texture))
+ (sw (/ tile-width w))
+ (th (/ tile-height h))
+ (rows (/ (- h margin) (+ tile-height spacing)))
+ (columns (/ (- w margin) (+ tile-width spacing)))
+ (v (make-vector (* rows columns))))
+ (define (make-tile tx ty)
+ (let* ((x (+ (* tx (+ tile-width spacing)) margin))
+ (y (+ (* ty (+ tile-height spacing)) margin)))
+ (make-rect (/ x w) (/ y h) sw th)))
+ (let y-loop ((y 0))
+ (when (< y rows)
+ (let x-loop ((x 0))
+ (when (< x columns)
+ (vector-set! v (+ x (* y columns)) (make-tile x y))
+ (x-loop (1+ x))))
+ (y-loop (1+ y))))
+ (%make-texture-atlas texture v)))