diff options
Diffstat (limited to 'chickadee/graphics/texture.scm')
| -rw-r--r-- | chickadee/graphics/texture.scm | 35 |
1 files changed, 14 insertions, 21 deletions
diff --git a/chickadee/graphics/texture.scm b/chickadee/graphics/texture.scm index 9a8a924..30ae9a0 100644 --- a/chickadee/graphics/texture.scm +++ b/chickadee/graphics/texture.scm @@ -29,6 +29,7 @@ #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) #:use-module (chickadee graphics gl) + #:use-module (chickadee utils) #:export (make-texture make-texture-region load-image @@ -229,13 +230,11 @@ by the bounding box RECT." HEIGHT, 32 bit color bytevector." (let ((buffer (make-u8vector (bytevector-length pixels))) (row-width (* width 4))) ; assuming 32 bit color - (let loop ((y 0)) - (when (< y height) - (let* ((y* (- height y 1)) - (source-start (* y row-width)) - (target-start (* y* row-width))) - (bytevector-copy! pixels source-start buffer target-start row-width) - (loop (1+ y))))) + (for-range ((y height)) + (let* ((y* (- height y 1)) + (source-start (* y row-width)) + (target-start (* y* row-width))) + (bytevector-copy! pixels source-start buffer target-start row-width))) buffer)) (define (surface->texture surface min-filter mag-filter wrap-s wrap-t transparent-color) @@ -254,13 +253,11 @@ the given MIN-FILTER and MAG-FILTER." (g (inexact->exact (* (color-g transparent-color) 255))) (b (inexact->exact (* (color-b transparent-color) 255))) (pixel-count (* width height 4))) - (let loop ((i 0)) - (when (< i pixel-count) - (when (and (= r (bytevector-u8-ref pixels i)) - (= g (bytevector-u8-ref pixels (+ i 1))) - (= b (bytevector-u8-ref pixels (+ i 2)))) - (bytevector-u8-set! pixels (+ i 3) 0)) - (loop (+ i 4)))))) + (for-range ((i pixel-count 0 4)) + (when (and (= r (bytevector-u8-ref pixels i)) + (= g (bytevector-u8-ref pixels (+ i 1))) + (= b (bytevector-u8-ref pixels (+ i 2)))) + (bytevector-u8-set! pixels (+ i 3) 0))))) (make-texture pixels width height #:min-filter min-filter #:mag-filter mag-filter @@ -343,13 +340,9 @@ terrain." (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)))) - (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)))) + (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 |