diff options
| -rw-r--r-- | chickadee/render/texture.scm | 73 |
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))) |