From 0c88e29f9ecbc026abe9a7fe99fd91ee28b01314 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Fri, 5 Mar 2021 07:48:14 -0500 Subject: Use new for-range macro wherever possible. --- chickadee/array-list.scm | 16 +++----- chickadee/audio.scm | 7 ++-- chickadee/graphics/font.scm | 25 ++++++------ chickadee/graphics/model.scm | 65 ++++++++++++++----------------- chickadee/graphics/path.scm | 86 ++++++++++++++++++------------------------ chickadee/graphics/shader.scm | 68 ++++++++++++++------------------- chickadee/graphics/texture.scm | 35 +++++++---------- chickadee/graphics/tiled.scm | 37 ++++++++---------- 8 files changed, 145 insertions(+), 194 deletions(-) diff --git a/chickadee/array-list.scm b/chickadee/array-list.scm index 8f5bb11..e18f9bf 100644 --- a/chickadee/array-list.scm +++ b/chickadee/array-list.scm @@ -16,6 +16,7 @@ ;;; . (define-module (chickadee array-list) + #:use-module (chickadee utils) #:use-module (ice-9 format) #:use-module (rnrs base) #:use-module (srfi srfi-9) @@ -128,22 +129,17 @@ (loop (+ i 1))))))) (define (array-list-clear! array-list) - (let ((size (array-list-size array-list)) - (vec (array-list-vector array-list))) + (let ((vec (array-list-vector array-list))) ;; Remove all element references so they can be GC'd. - (let loop ((i 0)) - (when (< i size) - (vector-set! vec i #f) - (loop (1+ i))))) + (for-range ((i (array-list-size array-list))) + (vector-set! vec i #f))) (set-array-list-size! array-list 0) *unspecified*) (define (array-list-for-each proc array-list) (let ((vec (array-list-vector array-list))) - (let loop ((i 0)) - (when (< i (array-list-size array-list)) - (proc i (vector-ref vec i)) - (loop (1+ i)))))) + (for-range ((i (array-list-size array-list))) + (proc i (vector-ref vec i))))) (define (array-list-fold proc init array-list) (let ((vec (array-list-vector array-list))) diff --git a/chickadee/audio.scm b/chickadee/audio.scm index aa56dac..61d033b 100644 --- a/chickadee/audio.scm +++ b/chickadee/audio.scm @@ -29,6 +29,7 @@ #:use-module (chickadee audio wav) #:use-module (chickadee math) #:use-module (chickadee math vector) + #:use-module (chickadee utils) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (rnrs bytevectors) @@ -280,10 +281,8 @@ ;; keep OpenAL busy until the next sound system update. ;; update-audio-system will add new buffers as they are unqueued ;; later. - (let loop ((i 0)) - (when (< i 8) ; TODO: allow variable number of buffers? - (source-buffer/stream source) - (loop (+ i 1))))) + (for-range ((i 8)) ; TODO: allow variable number of buffers? + (source-buffer/stream source))) (define (remove-streaming-source sound-system source) ;; Flush buffers. diff --git a/chickadee/graphics/font.scm b/chickadee/graphics/font.scm index c282c66..eb1de3f 100644 --- a/chickadee/graphics/font.scm +++ b/chickadee/graphics/font.scm @@ -42,6 +42,7 @@ #:use-module (chickadee graphics shader) #:use-module (chickadee graphics sprite) #:use-module (chickadee graphics texture) + #:use-module (chickadee utils) #:use-module (rnrs bytevectors) #:export (load-tile-font load-bitmap-font @@ -120,20 +121,16 @@ display it at POINT-SIZE. By default, the ASCII character is used." (when (> (+ x width) texture-size) (set! y next-y) (set! x 0)) - (let y-loop ((row 0)) - (when (< row height) - (let x-loop ((column 0)) - (when (< column width) - (let ((gray (u8vector-ref glyph-pixels - (+ (* row pitch) column))) - (offset (+ (* (+ y row) texture-size 4) - (* (+ x column) 4)))) - (u8vector-set! pixels offset 255) - (u8vector-set! pixels (+ offset 1) 255) - (u8vector-set! pixels (+ offset 2) 255) - (u8vector-set! pixels (+ offset 3) gray)) - (x-loop (+ column 1)))) - (y-loop (+ row 1)))) + (for-range ((column width) + (row height)) + (let ((gray (u8vector-ref glyph-pixels + (+ (* row pitch) column))) + (offset (+ (* (+ y row) texture-size 4) + (* (+ x column) 4)))) + (u8vector-set! pixels offset 255) + (u8vector-set! pixels (+ offset 1) 255) + (u8vector-set! pixels (+ offset 2) 255) + (u8vector-set! pixels (+ offset 3) gray))) (let ((spec (list char x y width height left top advance))) ;; 1 pixel of padding to avoid artifacts when texture is ;; scaled up. diff --git a/chickadee/graphics/model.scm b/chickadee/graphics/model.scm index 8fce4ba..0aff08d 100644 --- a/chickadee/graphics/model.scm +++ b/chickadee/graphics/model.scm @@ -34,6 +34,7 @@ #:use-module (chickadee graphics phong) #:use-module (chickadee graphics shader) #:use-module (chickadee graphics texture) + #:use-module (chickadee utils) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 rdelim) @@ -514,35 +515,31 @@ ;; - 2 floats for texture coordinate ;; - 3 floats for normal ;; - repeat for each face - (let loop ((i 0)) - (when (< i vertex-count) - (let ((offset (* i stride))) - (match (array-list-ref faces i) - ((vert-index tex-index norm-index) - ;; Vertex - (let ((v (array-list-ref vertices vert-index))) - (f32vector-set! mesh-data offset (vec3-x v)) - (f32vector-set! mesh-data (+ offset 1) (vec3-y v)) - (f32vector-set! mesh-data (+ offset 2) (vec3-z v))) - ;; Texture coordinate - (let ((t (if tex-index - (array-list-ref texcoords tex-index) - null-texcoord))) - (f32vector-set! mesh-data (+ offset 3) (vec2-x t)) - (f32vector-set! mesh-data (+ offset 4) (vec2-y t))) - ;; Normal - (let ((n (if norm-index - (array-list-ref normals norm-index) - null-normal))) - (f32vector-set! mesh-data (+ offset 5) (vec3-x n)) - (f32vector-set! mesh-data (+ offset 6) (vec3-y n)) - (f32vector-set! mesh-data (+ offset 7) (vec3-z n)))))) - (loop (+ i 1)))) + (for-range ((i vertex-count)) + (let ((offset (* i stride))) + (match (array-list-ref faces i) + ((vert-index tex-index norm-index) + ;; Vertex + (let ((v (array-list-ref vertices vert-index))) + (f32vector-set! mesh-data offset (vec3-x v)) + (f32vector-set! mesh-data (+ offset 1) (vec3-y v)) + (f32vector-set! mesh-data (+ offset 2) (vec3-z v))) + ;; Texture coordinate + (let ((t (if tex-index + (array-list-ref texcoords tex-index) + null-texcoord))) + (f32vector-set! mesh-data (+ offset 3) (vec2-x t)) + (f32vector-set! mesh-data (+ offset 4) (vec2-y t))) + ;; Normal + (let ((n (if norm-index + (array-list-ref normals norm-index) + null-normal))) + (f32vector-set! mesh-data (+ offset 5) (vec3-x n)) + (f32vector-set! mesh-data (+ offset 6) (vec3-y n)) + (f32vector-set! mesh-data (+ offset 7) (vec3-z n))))))) ;; Pack indices. - (let loop ((i 0)) - (when (< i index-count) - (u32vector-set! mesh-indices i (array-list-ref face-indices i)) - (loop (+ i 1)))) + (for-range ((i index-count)) + (u32vector-set! mesh-indices i (array-list-ref face-indices i))) ;; Construct vertex array. ;; TODO: Add names to buffers and views. (let* ((index-buffer (make-buffer mesh-indices #:target 'index)) @@ -1004,10 +1001,8 @@ meshes))) (vector-set! nodes i node) node)))) - (let loop ((i 0)) - (when (< i (vector-length array)) - (parse-node* i) - (loop (+ i 1)))) + (for-range ((i (vector-length array))) + (parse-node* i)) nodes) (define (parse-scene obj nodes) (let ((name (or (string-ref/optional obj "name") "anonymous")) @@ -1019,10 +1014,8 @@ (make-scene-node #:name name #:children children))) (define (vector-map proc v) (let ((new-v (make-vector (vector-length v)))) - (let loop ((i 0)) - (when (< i (vector-length v)) - (vector-set! new-v i (proc (vector-ref v i))) - (loop (+ i 1)))) + (for-range ((i (vector-length v))) + (vector-set! new-v i (proc (vector-ref v i)))) new-v)) (call-with-input-file file-name (lambda (port) diff --git a/chickadee/graphics/path.scm b/chickadee/graphics/path.scm index 0ab7131..978f3ab 100644 --- a/chickadee/graphics/path.scm +++ b/chickadee/graphics/path.scm @@ -37,6 +37,7 @@ #:use-module (chickadee math matrix) #:use-module (chickadee math rect) #:use-module (chickadee math vector) + #:use-module (chickadee utils) #:use-module (gl) #:use-module (ice-9 match) #:use-module ((rnrs base) #:select (mod)) @@ -1038,42 +1039,33 @@ (set-filled-path-count! filled-path path-count) ;; TODO: Don't allocate each time. (let ((bv (make-u32vector path-count))) - (let loop ((i 0)) - (when (< i path-count) - (u32vector-set! bv i (+ (u32vector-ref counts i) 1)) - (loop (+ i 1)))) + (for-range ((i path-count)) + (u32vector-set! bv i (+ (u32vector-ref counts i) 1))) (set-filled-path-counts! filled-path bv)) (let ((bv (make-u32vector path-count))) - (let loop ((i 0)) - (when (< i path-count) - (u32vector-set! bv i (+ (u32vector-ref offsets i) i)) - (loop (+ i 1)))) + (for-range ((i path-count)) + (u32vector-set! bv i (+ (u32vector-ref offsets i) i))) (set-filled-path-offsets! filled-path bv)) ;; Create geometry for the stencil buffer. (geometry-begin! stencil-geometry) - (let loop ((i 0)) - (when (< i path-count) - (let* ((count (u32vector-ref counts i)) - (first (u32vector-ref offsets i)) - (last (+ first count -1))) - ;; Build the triangle fan for the path. This geometry - ;; will be used for a GPU-based implementation of the - ;; non-zero rule: - ;; - ;; See: https://en.wikipedia.org/wiki/Nonzero-rule - ;; - ;; Add reference point as the basis for each triangle in - ;; the fan. - (fill-vertex-append! stencil-geometry (ref-x ref-y)) - ;; Now simply copy all the points in the path into the - ;; buffer. - (let inner ((i first)) - (when (<= i last) - (fill-vertex-append! stencil-geometry - ((f32vector-ref points (* i 2)) - (f32vector-ref points (+ (* i 2) 1)))) - (inner (+ i 1))))) - (loop (+ i 1)))) + (for-range ((i path-count)) + (let* ((count (u32vector-ref counts i)) + (first (u32vector-ref offsets i))) + ;; Build the triangle fan for the path. This geometry + ;; will be used for a GPU-based implementation of the + ;; non-zero rule: + ;; + ;; See: https://en.wikipedia.org/wiki/Nonzero-rule + ;; + ;; Add reference point as the basis for each triangle in + ;; the fan. + (fill-vertex-append! stencil-geometry (ref-x ref-y)) + ;; Now simply copy all the points in the path into the + ;; buffer. + (for-range ((j (+ first count) first)) + (fill-vertex-append! stencil-geometry + ((f32vector-ref points (* j 2)) + (f32vector-ref points (+ (* j 2) 1))))))) (geometry-end! stencil-geometry) ;; Create simple quad covering the bounding box to be used for the ;; final render pass with stencil applied. @@ -1121,15 +1113,13 @@ ;; Wireframe debug mode. (when *debug?* (with-graphics-state ((polygon-mode line-polygon-mode)) - (let loop ((i 0)) - (when (< i n) - (shader-apply* shader - (geometry-vertex-array stencil-geometry) - (u32vector-ref offsets i) - (u32vector-ref counts i) - #:mvp (current-projection) - #:mode 0) - (loop (+ i 1)))))) + (for-range ((i n)) + (shader-apply* shader + (geometry-vertex-array stencil-geometry) + (u32vector-ref offsets i) + (u32vector-ref counts i) + #:mvp (current-projection) + #:mode 0)))) ;; Anti-alias the edges of the fill. (with-graphics-state ((multisample? #t)) ;; Render fan to stencil buffer. Each time a triangle is @@ -1145,15 +1135,13 @@ ;; http://developer.download.nvidia.com/devzone/devcenter/gamegraphics/files/opengl/gpupathrender.pdf (with-graphics-state ((color-mask null-color-mask) (stencil-test stencil-flip)) - (let loop ((i 0)) - (when (< i n) - (shader-apply* shader - (geometry-vertex-array stencil-geometry) - (u32vector-ref offsets i) - (u32vector-ref counts i) - #:mvp mvp - #:mode 0) - (loop (+ i 1))))) + (for-range ((i n)) + (shader-apply* shader + (geometry-vertex-array stencil-geometry) + (u32vector-ref offsets i) + (u32vector-ref counts i) + #:mvp mvp + #:mode 0))) ;; Render a quad with the stencil applied. The quad is the size ;; of the path's bounding box. The stencil test will make it so ;; we only draw fragments that are part of the filled path. diff --git a/chickadee/graphics/shader.scm b/chickadee/graphics/shader.scm index 2bd0f18..335f79c 100644 --- a/chickadee/graphics/shader.scm +++ b/chickadee/graphics/shader.scm @@ -35,6 +35,7 @@ #:use-module (chickadee graphics engine) #:use-module (chickadee graphics gl) #:use-module (chickadee graphics texture) + #:use-module (chickadee utils) #:export (shader-data-type? bool int @@ -105,10 +106,8 @@ (let ((serialize (shader-primitive-type-serializer type))) (if (vector? data) (let ((size (shader-primitive-type-size type))) - (let loop ((i 0)) - (when (< i (vector-length data)) - (serialize bv (* i size) (vector-ref data i)) - (loop (+ i 1))))) + (for-range ((i (vector-length data))) + (serialize bv (* i size) (vector-ref data i)))) (serialize bv 0 data)))) (define (shader-primitive-type-apply-uniform type location count pointer) @@ -273,10 +272,8 @@ (validate value)) ((and (vector? value) (= (vector-length value) size)) - (let loop ((i 0)) - (when (< i (vector-length value)) - (validate (vector-ref value i)) - (loop (+ i 1))))) + (for-range ((i (vector-length value))) + (validate (vector-ref value i)))) ((vector? value) (error "incorrect vector size" value)) (else @@ -695,27 +692,25 @@ them into a GPU shader program." (define (extract-attributes id) (let ((total (attribute-count id)) (table (make-hash-table))) - (let loop ((i 0)) - (unless (= i total) - (let ((length-bv (make-u32vector 1)) - (size-bv (make-u32vector 1)) - (type-bv (make-u32vector 1)) - (name-bv (make-bytevector 255))) - (gl-get-active-attrib id i - (bytevector-length name-bv) - (bytevector->pointer length-bv) - (bytevector->pointer size-bv) - (bytevector->pointer type-bv) - (bytevector->pointer name-bv)) - (let* ((length (u32vector-ref length-bv 0)) - (name (utf8->string* name-bv length)) - (size (u32vector-ref size-bv 0)) - (type (parse-data-type (u32vector-ref type-bv 0))) - (location (gl-get-attrib-location id name))) - (unless (= size 1) - (error "unsupported attribute size" name size)) - (hash-set! table name (make-attribute name location type)))) - (loop (1+ i)))) + (for-range ((i total)) + (let ((length-bv (make-u32vector 1)) + (size-bv (make-u32vector 1)) + (type-bv (make-u32vector 1)) + (name-bv (make-bytevector 255))) + (gl-get-active-attrib id i + (bytevector-length name-bv) + (bytevector->pointer length-bv) + (bytevector->pointer size-bv) + (bytevector->pointer type-bv) + (bytevector->pointer name-bv)) + (let* ((length (u32vector-ref length-bv 0)) + (name (utf8->string* name-bv length)) + (size (u32vector-ref size-bv 0)) + (type (parse-data-type (u32vector-ref type-bv 0))) + (location (gl-get-attrib-location id name))) + (unless (= size 1) + (error "unsupported attribute size" name size)) + (hash-set! table name (make-attribute name location type))))) table)) (let ((vertex-id (make-shader-stage (version-2-0 vertex-shader) vertex-port)) @@ -785,11 +780,8 @@ shader program." (traverse uniform)) thing)) ((uniform-array? thing) - (let ((size (uniform-array-size thing))) - (let loop ((i 0)) - (when (< i size) - (traverse (uniform-array-namespace-ref thing i)) - (loop (+ i 1)))))))) + (for-range ((i (uniform-array-size thing))) + (traverse (uniform-array-namespace-ref thing i)))))) (traverse (shader-uniforms shader))) ;; TODO: This walks the entire tree every time, but it should instead @@ -827,11 +819,9 @@ shader program." ;; Vector size must match what the shader expects. (if (and (vector? value) (= size (vector-length value))) - (let loop ((i 0)) - (when (< i size) - (traverse (uniform-array-namespace-ref uniform i) - (vector-ref value i)) - (loop (+ i 1)))) + (for-range ((i size)) + (traverse (uniform-array-namespace-ref uniform i) + (vector-ref value i))) (error "vector size mismatch for uniform" (uniform-array-name uniform))))))) ;; Walk the uniform namespace tree until we get to a leaf node or 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 diff --git a/chickadee/graphics/tiled.scm b/chickadee/graphics/tiled.scm index 2d2e88f..6500a17 100644 --- a/chickadee/graphics/tiled.scm +++ b/chickadee/graphics/tiled.scm @@ -29,6 +29,7 @@ #:use-module (chickadee graphics sprite) #:use-module (chickadee graphics texture) #:use-module (chickadee graphics viewport) + #:use-module (chickadee utils) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) @@ -253,13 +254,11 @@ (let ((tile (parse-tile node rows columns atlas batch))) (hash-set! table (tile-id tile) tile))) nodes) - (let loop ((i 0)) - (when (< i size) - (let ((tile - (or (hash-ref table i) - (%make-tile i (texture-atlas-ref atlas i) batch #f '())))) - (vector-set! tiles i tile)) - (loop (+ i 1)))) + (for-range ((i size)) + (let ((tile + (or (hash-ref table i) + (%make-tile i (texture-atlas-ref atlas i) batch #f '())))) + (vector-set! tiles i tile))) tiles)) (define (first-gid node) (attr node 'firstgid string->number)) @@ -418,20 +417,16 @@ (define (draw-tile-layer layer matrix x1 y1 x2 y2) (let ((width (tile-layer-width layer)) (height (tile-layer-height layer))) - (let y-loop ((y y1)) - (when (< y y2) - (let x-loop ((x x1)) - (when (< x x2) - (let ((tile (vector-ref (tile-layer-tiles layer) - (+ (* y width) x)))) - (when tile - (let ((tref (map-tile-ref tile))) - (sprite-batch-add* (tile-batch tref) - (map-tile-rect tile) - matrix - #:texture-region (tile-texture tref))))) - (x-loop (+ x 1)))) - (y-loop (+ y 1)))))) + (for-range ((x x2 x1) + (y y2 y1)) + (let ((tile (vector-ref (tile-layer-tiles layer) + (+ (* y width) x)))) + (when tile + (let ((tref (map-tile-ref tile))) + (sprite-batch-add* (tile-batch tref) + (map-tile-rect tile) + matrix + #:texture-region (tile-texture tref)))))))) (define* (draw-tile-map* tile-map matrix region #:key layers) ;; Calculate the tiles that are visible so we don't waste time -- cgit v1.2.3