From db34d810809120ad36a9c53580b55658c4906e95 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 9 Apr 2021 22:39:01 -0400
Subject: graphics: texture: Add texture-tileset-dimensions procedure.

---
 chickadee/graphics/texture.scm | 37 ++++++++++++++++++++++++-------------
 1 file 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)
-- 
cgit v1.2.3