summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/graphics/texture.scm37
1 files changed, 24 insertions, 13 deletions
diff --git a/chickadee/graphics/texture.scm b/chickadee/graphics/texture.scm
index 24aa0f5..fbf5bdc 100644
--- a/chickadee/graphics/texture.scm
+++ b/chickadee/graphics/texture.scm
@@ -60,6 +60,7 @@
texture-atlas
list->texture-atlas
split-texture
+ texture-tileset-dimensions
texture-atlas?
texture-atlas-texture
texture-atlas-ref
@@ -327,6 +328,15 @@ within."
ATLAS."
(vector-ref (texture-atlas-vector atlas) index))
+(define* (texture-tileset-dimensions texture tile-width tile-height #:key
+ (margin 0) (spacing 0))
+ (values (inexact->exact
+ (ceiling (/ (- (texture-width texture) margin)
+ (+ tile-width spacing))))
+ (inexact->exact
+ (ceiling (/ (- (texture-height texture) margin)
+ (+ tile-height spacing))))))
+
(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
@@ -337,19 +347,20 @@ 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))
- (rows (inexact->exact (ceiling (/ (- h margin) (+ tile-height spacing)))))
- (columns (inexact->exact (ceiling (/ (- 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-texture-region texture (make-rect x y tile-width tile-height))))
- (for-range ((x columns)
- (y rows))
- (vector-set! v (+ x (* y columns)) (make-tile x y)))
- (%make-texture-atlas texture v)))
+ (call-with-values (lambda ()
+ (texture-tileset-dimensions texture tile-width tile-height
+ #:margin margin
+ #:spacing spacing))
+ (lambda (columns rows)
+ (let ((v (make-vector (* rows columns))))
+ (define (make-tile tx ty)
+ (let* ((x (+ (* tx (+ tile-width spacing)) margin))
+ (y (+ (* ty (+ tile-height spacing)) margin)))
+ (make-texture-region texture (make-rect x y tile-width tile-height))))
+ (for-range ((x columns)
+ (y rows))
+ (vector-set! v (+ x (* y columns)) (make-tile x y)))
+ (%make-texture-atlas texture v)))))
(define* (load-tileset file-name tile-width tile-height #:key
(margin 0)