summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2016-02-27 20:45:09 -0500
committerDavid Thompson <dthompson2@worcester.edu>2016-02-27 20:45:09 -0500
commit873d00e01e7d714fd3cbbb86d3da88380c179145 (patch)
tree3f6d34fa1cdf08ec17475126451f93fd86847ecf
parenta319acd01ac950d479d43d77c07d44a9af3012cd (diff)
math: Rewrite vector math library to use packed f64 bytevectors.
The big consequence of this change to the rest of the codebase is that we can no longer use record destructuring when pattern matching, so I had to rewrite every place where pattern matching was used. It was probably a bad idea to expose the record type descriptors publicly in the first place. * sly/math/vector.scm: Reimplement everything in terms of an f64 packed bytevector record type. Do not expose record type descriptors. * sly/game.scm (run-game-loop): Convert viewport width/height to exact numbers. * sly/window.scm (open-window): Likewise. * sly/input/mouse.scm (mouse-position): Rewrite pattern matching. * sly/math/quaternion (make-quaternion, vector->quaternion): Likewise. * sly/math/rect.scm (rect-clamp): Likewise. * sly/math/transform.scm (translate!, translate, scale): Likewise. * sly/render/mesh.scm (vertices-bytevector): Likewise. * examples/mines/mines.scm: Likewise.
-rw-r--r--examples/mines/mines.scm5
-rw-r--r--sly/game.scm4
-rw-r--r--sly/input/mouse.scm6
-rw-r--r--sly/math/quaternion.scm14
-rw-r--r--sly/math/rect.scm6
-rw-r--r--sly/math/transform.scm75
-rw-r--r--sly/math/vector.scm349
-rw-r--r--sly/render/mesh.scm49
-rw-r--r--sly/window.scm3
9 files changed, 339 insertions, 172 deletions
diff --git a/examples/mines/mines.scm b/examples/mines/mines.scm
index 0b93473..954f17f 100644
--- a/examples/mines/mines.scm
+++ b/examples/mines/mines.scm
@@ -163,8 +163,9 @@
(define (board-update board position tile)
(match position
- (($ <vector2> x y)
- (list-replace board y (list-replace (list-ref board y) x tile)))))
+ ((? vector2? v)
+ (list-replace board (vy v)
+ (list-replace (list-ref board y) (vx v) tile)))))
(define (neighbors board pos)
(let* ((size (length board))
diff --git a/sly/game.scm b/sly/game.scm
index 66f0893..f4fb948 100644
--- a/sly/game.scm
+++ b/sly/game.scm
@@ -106,7 +106,9 @@ instead of becoming completely unresponsive and possibly crashing."
(define (draw dt alpha)
"Render a frame."
(let ((size (signal-ref window-size)))
- (gl-viewport 0 0 (vx size) (vy size)))
+ (gl-viewport 0 0
+ (inexact->exact (vx size))
+ (inexact->exact (vy size))))
(gl-clear (clear-buffer-mask color-buffer depth-buffer))
(run-hook draw-hook dt alpha)
(with-graphics gfx
diff --git a/sly/input/mouse.scm b/sly/input/mouse.scm
index c6d2b96..815fee6 100644
--- a/sly/input/mouse.scm
+++ b/sly/input/mouse.scm
@@ -53,8 +53,10 @@
;; Sly uses the bottom-left as the origin, so invert
;; the y-axis for convenience.
(match-lambda
- (($ <vector2> x y)
- (vector2 x (- (signal-ref window-height) y))))))
+ ((? vector2? v)
+ (vector2 (vector2-x v)
+ (- (signal-ref window-height)
+ (vector2-y v)))))))
(define-signal mouse-x (signal-map vx mouse-position))
(define-signal mouse-y (signal-map vy mouse-position))
diff --git a/sly/math/quaternion.scm b/sly/math/quaternion.scm
index f07eef1..1fc1fa3 100644
--- a/sly/math/quaternion.scm
+++ b/sly/math/quaternion.scm
@@ -45,10 +45,13 @@
(define make-quaternion
(match-lambda*
- ((($ <vector3> x y z) (? number? theta))
+ (((? vector3? v) (? number? theta))
;; Convert an axis angle to a quaternion
(let* ((theta/2 (/ theta 2))
- (sin (sin theta/2)))
+ (sin (sin theta/2))
+ (x (vector3-x v))
+ (y (vector3-y v))
+ (z (vector3-z v)))
(%make-quaternion (cos theta/2) (* x sin) (* y sin) (* z sin))))
((w x y z)
(%make-quaternion w x y z))))
@@ -108,5 +111,8 @@ Q2 and blending factor DELTA."
(define vector->quaternion
(match-lambda
- (($ <vector4> x y z w)
- (make-quaternion x y z w))))
+ ((? vector4? v)
+ (make-quaternion (vector4-x v)
+ (vector4-y v)
+ (vector4-z v)
+ (vector4-w v)))))
diff --git a/sly/math/rect.scm b/sly/math/rect.scm
index 07358f6..362cf69 100644
--- a/sly/math/rect.scm
+++ b/sly/math/rect.scm
@@ -187,9 +187,9 @@ RECT2. If the rects do not overlap, a rect of size 0 is returned."
(define rect-clamp
(match-lambda*
- ((($ <rect> rx ry width height) ($ <vector2> x y))
- (vector2 (clamp rx (+ rx width) x)
- (clamp ry (+ ry height) y)))))
+ ((($ <rect> rx ry width height) (? vector2? v))
+ (vector2 (clamp rx (+ rx width) (vector2-x v))
+ (clamp ry (+ ry height) (vector2-y v))))))
(define (rect-within? rect1 rect2)
"Return #t if RECT2 is completely within RECT1."
diff --git a/sly/math/transform.scm b/sly/math/transform.scm
index 38fd464..234f6b1 100644
--- a/sly/math/transform.scm
+++ b/sly/math/transform.scm
@@ -275,29 +275,39 @@ called without any arguments."
(define (translate! t . args)
(match args
- (($ <vector2> x y)
- (make-transform 1 0 0 0
- 0 1 0 0
- 0 0 1 0
- x y 0 1))
- (($ <vector3> x y z)
- (make-transform 1 0 0 0
- 0 1 0 0
- 0 0 1 0
- x y z 1))))
+ ((? transform? v)
+ (let ((x (vector2-x v))
+ (y (vector2-y v)))
+ (make-transform 1 0 0 0
+ 0 1 0 0
+ 0 0 1 0
+ x y 0 1)))
+ ((? vector3? v)
+ (let ((x (vector3-x v))
+ (y (vector3-y v))
+ (z (vector3-z v)))
+ (make-transform 1 0 0 0
+ 0 1 0 0
+ 0 0 1 0
+ x y z 1)))))
(define translate
(match-lambda
- (($ <vector2> x y)
- (make-transform 1 0 0 0
- 0 1 0 0
- 0 0 1 0
- x y 0 1))
- (($ <vector3> x y z)
- (make-transform 1 0 0 0
- 0 1 0 0
- 0 0 1 0
- x y z 1))
+ ((? vector2? v)
+ (let ((x (vector2-x v))
+ (y (vector2-y v)))
+ (make-transform 1 0 0 0
+ 0 1 0 0
+ 0 0 1 0
+ x y 0 1)))
+ ((? vector3? v)
+ (let ((x (vector3-x v))
+ (y (vector3-y v))
+ (z (vector3-z v)))
+ (make-transform 1 0 0 0
+ 0 1 0 0
+ 0 0 1 0
+ x y z 1)))
(v (error "Invalid translation vector: " v))))
(define scale
@@ -307,16 +317,21 @@ called without any arguments."
0 v 0 0
0 0 v 0
0 0 0 1))
- (($ <vector2> x y)
- (make-transform x 0 0 0
- 0 y 0 0
- 0 0 1 0
- 0 0 0 1))
- (($ <vector3> x y z)
- (make-transform x 0 0 0
- 0 y 0 0
- 0 0 z 0
- 0 0 0 1))
+ ((? vector2? v)
+ (let ((x (vector2-x v))
+ (y (vector2-y v)))
+ (make-transform x 0 0 0
+ 0 y 0 0
+ 0 0 1 0
+ 0 0 0 1)))
+ ((? vector3? v)
+ (let ((x (vector3-x v))
+ (y (vector3-y v))
+ (z (vector3-z v)))
+ (make-transform x 0 0 0
+ 0 y 0 0
+ 0 0 z 0
+ 0 0 0 1)))
(v (error "Invalid scaling vector: " v))))
(define (rotate-x angle)
diff --git a/sly/math/vector.scm b/sly/math/vector.scm
index 33c62d8..778526e 100644
--- a/sly/math/vector.scm
+++ b/sly/math/vector.scm
@@ -23,60 +23,63 @@
(define-module (sly math vector)
#:use-module (ice-9 match)
+ #:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (sly math)
- #:export (<vector2>
- <vector3>
- <vector4>
- vector2 vector3 vector4
+ #:use-module (sly records)
+ #:export (vector2 vector3 vector4
vector2? vector3? vector4?
vx vy vz vw
+ vector2-x vector2-y
+ vector3-x vector3-y vector3-z
+ vector4-x vector4-y vector4-z vector4-w
vmap v+ v- v* vdot vcross
magnitude normalize vlerp))
-(define-record-type <vector2>
- (vector2 x y)
+(define-packed-f64-record-type <vector2>
+ vector2
+ bytevector->vector2 vector2->bytevector
vector2?
- (x vector2-x)
- (y vector2-y))
+ (x 0 vector2-x set-vector2-x!)
+ (y 1 vector2-y set-vector2-y!))
-(define-record-type <vector3>
- (vector3 x y z)
+(define-packed-f64-record-type <vector3>
+ vector3
+ bytevector->vector3 vector3->bytevector
vector3?
- (x vector3-x)
- (y vector3-y)
- (z vector3-z))
+ (x 0 vector3-x set-vector3-x!)
+ (y 1 vector3-y set-vector3-y!)
+ (z 2 vector3-z set-vector3-z!))
-(define-record-type <vector4>
- (vector4 x y z w)
+(define-packed-f64-record-type <vector4>
+ vector4
+ bytevector->vector4 vector4->bytevector
vector4?
- (x vector4-x)
- (y vector4-y)
- (z vector4-z)
- (w vector4-w))
-
-(define vx
- (match-lambda
- ((or ($ <vector2> x _)
- ($ <vector3> x _ _)
- ($ <vector4> x _ _ _))
- x)))
-
-(define vy
- (match-lambda
- ((or ($ <vector2> _ y)
- ($ <vector3> _ y _)
- ($ <vector4> _ y _ _))
- y)))
-
-(define vz
- (match-lambda
- ((or ($ <vector3> _ _ z)
- ($ <vector4> _ _ z _))
- z)))
-
-(define vw vector4-w)
+ (x 0 vector4-x set-vector4-x!)
+ (y 1 vector4-y set-vector4-y!)
+ (z 2 vector4-z set-vector4-z!)
+ (w 3 vector4-w set-vector4-w!))
+
+(define-inlinable (vx v)
+ (cond
+ ((vector2? v) (vector2-x v))
+ ((vector3? v) (vector3-x v))
+ ((vector4? v) (vector4-x v))))
+
+(define-inlinable (vy v)
+ (cond
+ ((vector2? v) (vector2-y v))
+ ((vector3? v) (vector3-y v))
+ ((vector4? v) (vector4-y v))))
+
+(define-inlinable (vz v)
+ (cond
+ ((vector3? v) (vector3-z v))
+ ((vector4? v) (vector4-z v))))
+
+(define-inlinable (vw v)
+ (vector4-w v))
(define (vmap proc v)
"Return a new vector that is the result of applying PROC to each
@@ -89,80 +92,218 @@ element of the 2D/3D/4D vector V."
(($ <vector4> x y z w)
(vector4 (proc x) (proc y) (proc z) (proc w)))))
-(define-syntax-rule (vector-lambda proc)
- (match-lambda*
- ((($ <vector2> x1 y1) ($ <vector2> x2 y2))
- (vector2 (proc x1 x2) (proc y1 y2)))
- ((($ <vector2> x y) (? number? k))
- (vector2 (proc x k) (proc y k)))
- (((? number? k) ($ <vector2> x y))
- (vector2 (proc k x) (proc k y)))
- ((($ <vector3> x1 y1 z1) ($ <vector3> x2 y2 z2))
- (vector3 (proc x1 x2) (proc y1 y2) (proc z1 z2)))
- ((($ <vector3> x y z) (? number? k))
- (vector3 (proc x k) (proc y k) (proc z k)))
- (((? number? k) ($ <vector3> x y z))
- (vector3 (proc k x) (proc k y) (proc k z)))
- ((($ <vector4> x1 y1 z1 w1) ($ <vector4> x2 y2 z2 w2))
- (vector4 (proc x1 x2) (proc y1 y2) (proc z1 z2) (proc w1 w2)))
- ((($ <vector4> x y z w) (? number? k))
- (vector4 (proc x k) (proc y k) (proc z k) (proc w k)))
- (((? number? k) ($ <vector4> x y z w))
- (vector4 (proc k x) (proc k y) (proc k z) (proc k w)))))
+;; Hoo boy, the things we do for efficiency. ;)
+(define-syntax-rule (vector-arithmetic vectors op identity)
+ (match vectors
+ ;; Common cases: Adding just 2 vectors of the same type.
+ ;; Matching against them here means avoiding the more expensive,
+ ;; more general loops later on.
+ (((and (? vector2?) (= vector2->bytevector bv1))
+ (and (? vector2?) (= vector2->bytevector bv2)))
+ (bytevector->vector2
+ (f64vector (op (f64vector-ref bv1 0)
+ (f64vector-ref bv2 0))
+ (op (f64vector-ref bv1 1)
+ (f64vector-ref bv2 1)))))
+ (((and (? vector3?) (= vector3->bytevector bv1))
+ (and (? vector3?) (= vector3->bytevector bv2)))
+ (bytevector->vector3
+ (f64vector (op (f64vector-ref bv1 0)
+ (f64vector-ref bv2 0))
+ (op (f64vector-ref bv1 1)
+ (f64vector-ref bv2 1))
+ (op (f64vector-ref bv1 2)
+ (f64vector-ref bv2 2)))))
+ (((and (? vector4?) (= vector4->bytevector bv1))
+ (and (? vector4?) (= vector4->bytevector bv2)))
+ (bytevector->vector4
+ (f64vector (op (f64vector-ref bv1 0)
+ (f64vector-ref bv2 0))
+ (op (f64vector-ref bv1 1)
+ (f64vector-ref bv2 1))
+ (op (f64vector-ref bv1 2)
+ (f64vector-ref bv2 2))
+ (op (f64vector-ref bv1 3)
+ (f64vector-ref bv2 3)))))
+ ;; Special cases for a list with a a single element, to handle use
+ ;; with subtraction.
+ (((and (? vector2?) (= vector2->bytevector head)))
+ (vector2 (op (f64vector-ref head 0))
+ (op (f64vector-ref head 1))))
+ (((and (? vector3?) (= vector3->bytevector head)))
+ (vector3 (op (f64vector-ref head 0))
+ (op (f64vector-ref head 1))
+ (op (f64vector-ref head 2))))
+ (((and (? vector4?) (= vector4->bytevector head)))
+ (vector4 (op (f64vector-ref head 0))
+ (op (f64vector-ref head 1))
+ (op (f64vector-ref head 2))
+ (op (f64vector-ref head 3))))
+ (((? number? x))
+ (op x))
+ ;; General case:
+ (vectors*
+ (let outer ((scalar-sum #f)
+ (vectors* vectors*))
+ (match vectors*
+ ;; First, add up all of the scalars that appear at the head of
+ ;; the list, before we've been able to determine which vector
+ ;; type to specialize on.
+ (() (or scalar-sum identity))
+ (((? number? x) . tail)
+ (outer (if scalar-sum (op scalar-sum x) x) tail))
+ ;; Specialize based on vector type once we actually encounter a
+ ;; vector.
+ ;;
+ ;; 2D vectors, possibly mixed with scalars:
+ (((and (? vector2?) (= vector2->bytevector head)) . tail)
+ (let ((bv (if scalar-sum
+ (f64vector (op scalar-sum
+ (f64vector-ref head 0))
+ (op scalar-sum
+ (f64vector-ref head 1)))
+ (bytevector-copy head))))
+ (let inner ((vectors* tail))
+ (match vectors*
+ (() (bytevector->vector2 bv))
+ (((? number? x) . tail)
+ (f64vector-set! bv 0 (op (f64vector-ref bv 0) x))
+ (f64vector-set! bv 1 (op (f64vector-ref bv 1) x))
+ (inner tail))
+ (((and (? vector2?) (= vector2->bytevector head)) . tail)
+ (f64vector-set! bv 0 (op (f64vector-ref bv 0)
+ (f64vector-ref head 0)))
+ (f64vector-set! bv 1 (op (f64vector-ref bv 1)
+ (f64vector-ref head 1)))
+ (inner tail))))))
+ ;; 3D vectors, possibly mixed with scalars:
+ (((and (? vector3?) (= vector3->bytevector head)) . tail)
+ (let ((bv (if scalar-sum
+ (f64vector (op scalar-sum
+ (f64vector-ref head 0))
+ (op scalar-sum
+ (f64vector-ref head 1))
+ (op scalar-sum
+ (f64vector-ref head 2)))
+ (bytevector-copy head))))
+ (let inner ((vectors* tail))
+ (match vectors*
+ (() (bytevector->vector3 bv))
+ (((? number? x) . tail)
+ (f64vector-set! bv 0 (op (f64vector-ref bv 0) x))
+ (f64vector-set! bv 1 (op (f64vector-ref bv 1) x))
+ (f64vector-set! bv 2 (op (f64vector-ref bv 2) x))
+ (inner tail))
+ (((and (? vector3?) (= vector3->bytevector head)) . tail)
+ (f64vector-set! bv 0 (op (f64vector-ref bv 0)
+ (f64vector-ref head 0)))
+ (f64vector-set! bv 1 (op (f64vector-ref bv 1)
+ (f64vector-ref head 1)))
+ (f64vector-set! bv 2 (op (f64vector-ref bv 2)
+ (f64vector-ref head 2)))
+ (inner tail))))))
+ ;; 4D vectors, possibly mixed with scalars:
+ (((and (? vector4?) (= vector4->bytevector head)) . tail)
+ (let ((bv (if scalar-sum
+ (f64vector (op scalar-sum
+ (f64vector-ref head 0))
+ (op scalar-sum
+ (f64vector-ref head 1))
+ (op scalar-sum
+ (f64vector-ref head 2))
+ (op scalar-sum
+ (f64vector-ref head 3)))
+ (bytevector-copy head))))
+ (let inner ((vectors* tail))
+ (match vectors*
+ (() (bytevector->vector4 bv))
+ (((? number? x) . tail)
+ (f64vector-set! bv 0 (op (f64vector-ref bv 0) x))
+ (f64vector-set! bv 1 (op (f64vector-ref bv 1) x))
+ (f64vector-set! bv 2 (op (f64vector-ref bv 2) x))
+ (f64vector-set! bv 3 (op (f64vector-ref bv 3) x))
+ (inner tail))
+ (((and (? vector4?) (= vector4->bytevector head)) . tail)
+ (f64vector-set! bv 0 (op (f64vector-ref bv 0)
+ (f64vector-ref head 0)))
+ (f64vector-set! bv 1 (op (f64vector-ref bv 1)
+ (f64vector-ref head 1)))
+ (f64vector-set! bv 2 (op (f64vector-ref bv 2)
+ (f64vector-ref head 2)))
+ (f64vector-set! bv 3 (op (f64vector-ref bv 3)
+ (f64vector-ref head 3)))
+ (inner tail)))))))))))
(define (v+ . vectors)
- (reduce (vector-lambda +) 0 vectors))
-
-(define v-
- (match-lambda*
- ((v) (v- 0 v))
- ((v v* ...)
- (fold-right (let ((- (vector-lambda -)))
- (lambda (prev v)
- (- v prev)))
- v v*))))
+ "Compute the sum of VECTORS."
+ (vector-arithmetic vectors + 0))
(define (v* . vectors)
- (reduce (vector-lambda *) 1 vectors))
-
-(define vdot
- (match-lambda*
- ((($ <vector2> x1 y1) ($ <vector2> x2 y2))
- (+ (* x1 x2) (* y1 y2)))
- ((($ <vector3> x1 y1 z1) ($ <vector3> x2 y2 z2))
- (+ (* x1 x2) (* y1 y2) (* z1 z2)))
- ((($ <vector4> x1 y1 z1 w1) ($ <vector4> x2 y2 z2 w2))
- (+ (* x1 x2) (* y1 y2) (* z1 z2) (* w1 w2)))))
-
-(define vcross
- (match-lambda*
- ((($ <vector3> x1 y1 z1) ($ <vector3> x2 y2 z2))
- (vector3 (- (* y1 z2) (* z1 y2))
- (- (* z1 x2) (* x1 z2))
- (- (* x1 y2) (* y1 x2))))))
+ "Compute the product of VECTORS."
+ (vector-arithmetic vectors * 1))
+
+(define (v- vectors . rest)
+ "Compute the difference of VECTORS."
+ (vector-arithmetic (cons vectors rest) - 0))
+
+(define (vdot v1 v2)
+ "Compute the dot product of the vectors V1 and V2."
+ (cond
+ ((and (vector2? v1) (vector2? v2))
+ (+ (* (vector2-x v1) (vector2-x v2))
+ (* (vector2-y v1) (vector2-y v2))))
+ ((and (vector3? v1) (vector3? v2))
+ (+ (* (vector3-x v1) (vector3-x v2))
+ (* (vector3-y v1) (vector3-y v2))
+ (* (vector3-z v1) (vector3-z v2))))
+ ((and (vector4? v1) (vector4? v2))
+ (+ (* (vector4-x v1) (vector4-x v2))
+ (* (vector4-y v1) (vector4-y v2))
+ (* (vector4-z v1) (vector4-z v2))
+ (* (vector4-w v1) (vector4-w v2))))))
+
+(define (vcross v1 v2)
+ "Compute the cross product of the 3D vectors V1 and V2."
+ (vector3 (- (* (vector3-y v1) (vector3-z v2))
+ (* (vector3-z v1) (vector3-y v2)))
+ (- (* (vector3-z v1) (vector3-x v2))
+ (* (vector3-x v1) (vector3-z v2)))
+ (- (* (vector3-x v1) (vector3-y v2))
+ (* (vector3-y v1) (vector3-x v2)))))
(define (magnitude v)
"Return the magnitude of the vector V."
(sqrt
- (match v
- (($ <vector2> x y)
- (+ (square x) (square y)))
- (($ <vector3> x y z)
- (+ (square x) (square y) (square z)))
- (($ <vector4> x y z w)
- (+ (square x) (square y) (square z) (square w))))))
+ (cond
+ ((vector2? v)
+ (+ (square (vector2-x v))
+ (square (vector2-y v))))
+ ((vector3? v)
+ (+ (square (vector3-x v))
+ (square (vector3-y v))
+ (square (vector3-z v))))
+ ((vector4? v)
+ (+ (square (vector4-x v))
+ (square (vector4-y v))
+ (square (vector4-z v))
+ (square (vector4-w v)))))))
(define (normalize v)
"Return the normalized form of the vector V."
(let ((m (magnitude v)))
- (if (zero? m)
- v
- (match v
- (($ <vector2> x y)
- (vector2 (/ x m) (/ y m)))
- (($ <vector3> x y z)
- (vector3 (/ x m) (/ y m) (/ z m)))
- (($ <vector4> x y z w)
- (vector4 (/ x m) (/ y m) (/ z m) (/ w m)))))))
+ (cond
+ ((zero? m) v)
+ ((vector2? v)
+ (vector2 (/ (vector2-x v) m)
+ (/ (vector2-y v) m)))
+ ((vector3? v)
+ (vector3 (/ (vector3-x v) m)
+ (/ (vector3-y v) m)
+ (/ (vector3-z v) m)))
+ ((vector4? v)
+ (vector4 (/ (vector4-x v) m)
+ (/ (vector4-y v) m)
+ (/ (vector4-z v) m)
+ (/ (vector4-w v) m))))))
(define vlerp (make-lerp v+ v*))
diff --git a/sly/render/mesh.scm b/sly/render/mesh.scm
index 7f38b29..273019d 100644
--- a/sly/render/mesh.scm
+++ b/sly/render/mesh.scm
@@ -133,33 +133,32 @@
(bv (if index?
(make-u32vector (vector-length vertices))
(make-f32vector (* (vector-length vertices)
- (attribute-size elem)))))
- (setter (if index? u32vector-set! f32vector-set!)))
+ (attribute-size elem))))))
(vector-for-each
(match-lambda*
- ((i (? number? k))
- (setter bv i k))
- ((i ($ <vector2> x y))
- (let ((offset (* i 2)))
- (setter bv offset x)
- (setter bv (1+ offset) y)))
- ((i ($ <vector3> x y z))
- (let ((offset (* i 3)))
- (setter bv offset x)
- (setter bv (1+ offset) y)
- (setter bv (+ offset 2) z)))
- ((i ($ <vector4> x y z w))
- (let ((offset (* i 4)))
- (setter bv offset x)
- (setter bv (1+ offset) y)
- (setter bv (+ offset 2) z)
- (setter bv (+ offset 3) w)))
- ((i (color? c))
- (let ((offset (* i 4)))
- (setter bv offset (color-r c))
- (setter bv (1+ offset) (color-g c))
- (setter bv (+ offset 2) (color-b c))
- (setter bv (+ offset 3) (color-a c)))))
+ ((i (? number? k))
+ (u32vector-set! bv i k))
+ ((i (? vector2? v))
+ (let ((offset (* i 2)))
+ (f32vector-set! bv offset (vector2-x v))
+ (f32vector-set! bv (1+ offset) (vector2-y v))))
+ ((i (? vector3? v))
+ (let ((offset (* i 3)))
+ (f32vector-set! bv offset (vector3-x v))
+ (f32vector-set! bv (1+ offset) (vector3-y v))
+ (f32vector-set! bv (+ offset 2) (vector3-z v))))
+ ((i (? vector4? v))
+ (let ((offset (* i 4)))
+ (f32vector-set! bv offset (vector4-x v))
+ (f32vector-set! bv (1+ offset) (vector4-y v))
+ (f32vector-set! bv (+ offset 2) (vector4-z v))
+ (f32vector-set! bv (+ offset 3) (vector4-w v))))
+ ((i (color? c))
+ (let ((offset (* i 4)))
+ (f32vector-set! bv offset (color-r c))
+ (f32vector-set! bv (1+ offset) (color-g c))
+ (f32vector-set! bv (+ offset 2) (color-b c))
+ (f32vector-set! bv (+ offset 3) (color-a c)))))
vertices)
bv))
diff --git a/sly/window.scm b/sly/window.scm
index 25b90fc..695cfd6 100644
--- a/sly/window.scm
+++ b/sly/window.scm
@@ -105,7 +105,8 @@
(init-window)
(let ((res (window-resolution window)))
(sdl2:set-window-title! %sdl-window (window-title window))
- (sdl2:set-window-size! %sdl-window (list (vx res) (vy res)))
+ (sdl2:set-window-size! %sdl-window
+ (map inexact->exact (list (vx res) (vy res))))
(sdl2:set-window-fullscreen! %sdl-window (window-fullscreen? window))
(sdl2:show-window! %sdl-window)
(signal-set! window-size res)))