summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-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)))