summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--chickadee/array-list.scm16
-rw-r--r--chickadee/audio.scm7
-rw-r--r--chickadee/graphics/font.scm25
-rw-r--r--chickadee/graphics/model.scm65
-rw-r--r--chickadee/graphics/path.scm86
-rw-r--r--chickadee/graphics/shader.scm68
-rw-r--r--chickadee/graphics/texture.scm35
-rw-r--r--chickadee/graphics/tiled.scm37
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 @@
;;; <http://www.gnu.org/licenses/>.
(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
generated by cgit v1.2.3 (git 2.25.4) at 2024-12-23 19:06:45 +0000