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