diff options
| -rw-r--r-- | chickadee/math/vector.scm | 290 |
1 files changed, 150 insertions, 140 deletions
diff --git a/chickadee/math/vector.scm b/chickadee/math/vector.scm index b2ff265..6266a47 100644 --- a/chickadee/math/vector.scm +++ b/chickadee/math/vector.scm @@ -71,18 +71,17 @@ vec3-add! vec3-sub!)) + +;; +;; 2D Vectors +;; + (define-record-type <vec2> (wrap-vec2 bv pointer) vec2? (bv unwrap-vec2) (pointer vec2-pointer set-vec2-pointer!)) -(define-record-type <vec3> - (wrap-vec3 bv pointer) - vec3? - (bv unwrap-vec3) - (pointer vec3-pointer set-vec3-pointer!)) - (define (vec2->pointer v) "Return a foreign pointer to V." ;; Create foreign pointer lazily. @@ -91,59 +90,28 @@ (set-vec2-pointer! v pointer) pointer))) -(define (vec3->pointer v) - "Return a foreign pointer to V." - ;; Create foreign pointer lazily. - (or (vec3-pointer v) - (let ((pointer (bytevector->pointer (unwrap-vec3 v)))) - (set-vec3-pointer! v pointer) - pointer))) - (define (make-null-vec2) (wrap-vec2 (make-f32vector 2) #f)) -(define (make-null-vec3) - (wrap-vec3 (make-f32vector 3) #f)) - (define-inlinable (vec2= a b) (and (= (vec2-x a) (vec2-x b)) (= (vec2-y a) (vec2-y b)))) -(define-inlinable (vec3= a b) - (and (= (vec3-x a) (vec3-x b)) - (= (vec3-y a) (vec3-y b)) - (= (vec3-z a) (vec3-z b)))) - (define-syntax-rule (with-new-vec2 name body ...) (let ((name (make-null-vec2))) body ... name)) -(define-syntax-rule (with-new-vec3 name body ...) - (let ((name (make-null-vec3))) body ... name)) - (define-inlinable (vec2-ref v i) (f32vector-ref (unwrap-vec2 v) i)) -(define-inlinable (vec3-ref v i) - (f32vector-ref (unwrap-vec3 v) i)) - (define-inlinable (vec2-set! v i x) (f32vector-set! (unwrap-vec2 v) i x)) -(define-inlinable (vec3-set! v i x) - (f32vector-set! (unwrap-vec3 v) i x)) - (define-inlinable (vec2 x y) "Return a new vec2 with coordinates (X, Y)." (with-new-vec2 v (vec2-set! v 0 x) (vec2-set! v 1 y))) -(define-inlinable (vec3 x y z) - (with-new-vec3 v - (vec3-set! v 0 x) - (vec3-set! v 1 y) - (vec3-set! v 2 z))) - (define-inlinable (vec2/polar origin r theta) "Return a new vec2 containing the Cartesian representation of the polar coordinate (R, THETA) with an arbitrary ORIGIN point." @@ -154,14 +122,155 @@ polar coordinate (R, THETA) with an arbitrary ORIGIN point." "Return the x coordinate of the vec2 V." (vec2-ref v 0)) -(define-inlinable (vec3-x v) - "Return the x coordinate of the vec3 V." - (vec3-ref v 0)) - (define-inlinable (vec2-y v) "Return the y coordinate of the vec2 V." (vec2-ref v 1)) +(define-inlinable (set-vec2-x! v x) + (vec2-set! v 0 x)) + +(define-inlinable (set-vec2-y! v y) + (vec2-set! v 1 y)) + +(define-inlinable (set-vec2! v x y) + (set-vec2-x! v x) + (set-vec2-y! v y)) + +(define (display-vec2 v port) + (format port "#<vec2 ~f, ~f>" (vec2-x v) (vec2-y v))) + +(set-record-type-printer! <vec2> display-vec2) + +(define (vec2-copy! source-vec2 target-vec2) + "Copy SOURCE-VEC2 to TARGET-VEC2." + (set-vec2-x! target-vec2 (vec2-x source-vec2)) + (set-vec2-y! target-vec2 (vec2-y source-vec2))) + +(define (vec2-copy vec2) + "Return a new vec2 that is a copy of VEC2." + (with-new-vec2 new + (vec2-copy! vec2 new))) + +(define-inlinable (vec2-magnitude v) + "Return the magnitude of the vec2 V." + (sqrt (+ (* (vec2-x v) (vec2-x v)) (* (vec2-y v) (vec2-y v))))) + +(define-inlinable (vec2-dot v1 v2) + "Return the dot product of the vec2s V1 and V2." + (+ (* (vec2-x v1) (vec2-x v2)) + (* (vec2-y v1) (vec2-y v2)))) + +(define-inlinable (vec2-cross v1 v2) + (- (* (vec2-x v1) (vec2-y v2)) + (* (vec2-y v1) (vec2-x v2)))) + +(define-inlinable (vec2-normalize! v) + "Normalize the vec2 V in-place." + (unless (and (zero? (vec2-x v)) (zero? (vec2-y v))) + (let ((m (vec2-magnitude v))) + (set-vec2-x! v (/ (vec2-x v) m)) + (set-vec2-y! v (/ (vec2-y v) m))))) + +(define (vec2-normalize v) + "Return the normalized form of the vec2 V." + (with-new-vec2 new + (vec2-copy! v new) + (vec2-normalize! new))) + +(define-inlinable (vec2-mult! v x) + "Multiply the vec2 V by X, a real number or vec2." + (if (real? x) + (begin + (set-vec2-x! v (* (vec2-x v) x)) + (set-vec2-y! v (* (vec2-y v) x))) + (begin + (set-vec2-x! v (* (vec2-x v) (vec2-x x))) + (set-vec2-y! v (* (vec2-y v) (vec2-y x)))))) + +(define-inlinable (vec2-add! v x) + "Add X, a real number or vec2, to the vec2 V." + (if (real? x) + (begin + (set-vec2-x! v (+ (vec2-x v) x)) + (set-vec2-y! v (+ (vec2-y v) x))) + (begin + (set-vec2-x! v (+ (vec2-x v) (vec2-x x))) + (set-vec2-y! v (+ (vec2-y v) (vec2-y x)))))) + +(define-inlinable (vec2-sub! v x) + "Subtract X, a real number or vec2, from the vec2 V." + (if (real? x) + (begin + (set-vec2-x! v (- (vec2-x v) x)) + (set-vec2-y! v (- (vec2-y v) x))) + (begin + (set-vec2-x! v (- (vec2-x v) (vec2-x x))) + (set-vec2-y! v (- (vec2-y v) (vec2-y x)))))) + +(define-inlinable (vec2* v x) + "Multiply V by X." + (let ((new (vec2-copy v))) + (vec2-mult! new x) + new)) + +(define-inlinable (vec2+ v x) + "Add X to V." + (let ((new (vec2-copy v))) + (vec2-add! new x) + new)) + +(define-inlinable (vec2- v x) + "Subtract X from V." + (let ((new (vec2-copy v))) + (vec2-sub! new x) + new)) + + +;; +;; 3D Vectors +;;; + +(define-record-type <vec3> + (wrap-vec3 bv pointer) + vec3? + (bv unwrap-vec3) + (pointer vec3-pointer set-vec3-pointer!)) + +(define (vec3->pointer v) + "Return a foreign pointer to V." + ;; Create foreign pointer lazily. + (or (vec3-pointer v) + (let ((pointer (bytevector->pointer (unwrap-vec3 v)))) + (set-vec3-pointer! v pointer) + pointer))) + +(define (make-null-vec3) + (wrap-vec3 (make-f32vector 3) #f)) + +(define-inlinable (vec3= a b) + (and (= (vec3-x a) (vec3-x b)) + (= (vec3-y a) (vec3-y b)) + (= (vec3-z a) (vec3-z b)))) + +(define-syntax-rule (with-new-vec3 name body ...) + (let ((name (make-null-vec3))) body ... name)) + +(define-inlinable (vec3-ref v i) + (f32vector-ref (unwrap-vec3 v) i)) + +(define-inlinable (vec3-set! v i x) + (f32vector-set! (unwrap-vec3 v) i x)) + +(define-inlinable (vec3 x y z) + (with-new-vec3 v + (vec3-set! v 0 x) + (vec3-set! v 1 y) + (vec3-set! v 2 z))) + +(define-inlinable (vec3-x v) + "Return the x coordinate of the vec3 V." + (vec3-ref v 0)) + (define-inlinable (vec3-y v) "Return the y coordinate of the vec3 V." (vec3-ref v 1)) @@ -170,45 +279,25 @@ polar coordinate (R, THETA) with an arbitrary ORIGIN point." "Return the z coordinate of the vec3 V." (vec3-ref v 2)) -(define-inlinable (set-vec2-x! v x) - (vec2-set! v 0 x)) - (define-inlinable (set-vec3-x! v x) (vec3-set! v 0 x)) -(define-inlinable (set-vec2-y! v y) - (vec2-set! v 1 y)) - (define-inlinable (set-vec3-y! v y) (vec3-set! v 1 y)) (define-inlinable (set-vec3-z! v z) (vec3-set! v 2 z)) -(define-inlinable (set-vec2! v x y) - (set-vec2-x! v x) - (set-vec2-y! v y)) - (define-inlinable (set-vec3! v x y z) (set-vec3-x! v x) (set-vec3-y! v y) (set-vec3-z! v z)) -(define (display-vec2 v port) - (format port "#<vec2 ~f, ~f>" (vec2-x v) (vec2-y v))) - -(set-record-type-printer! <vec2> display-vec2) - (define (display-vec3 v port) (format port "#<vec3 ~f, ~f, ~f>" (vec3-x v) (vec3-y v) (vec3-z v))) (set-record-type-printer! <vec3> display-vec3) -(define (vec2-copy! source-vec2 target-vec2) - "Copy SOURCE-VEC2 to TARGET-VEC2." - (set-vec2-x! target-vec2 (vec2-x source-vec2)) - (set-vec2-y! target-vec2 (vec2-y source-vec2))) - (define (vec3-copy! source-vec3 target-vec3) "Copy SOURCE-VEC3 to TARGET-VEC3." (set-vec3! target-vec3 @@ -216,41 +305,23 @@ polar coordinate (R, THETA) with an arbitrary ORIGIN point." (vec3-y source-vec3) (vec3-z source-vec3))) -(define (vec2-copy vec2) - "Return a new vec2 that is a copy of VEC2." - (with-new-vec2 new - (vec2-copy! vec2 new))) - (define (vec3-copy vec3) "Return a new vec3 that is a copy of VEC3." (with-new-vec3 new (vec3-copy! vec3 new))) -(define-inlinable (vec2-magnitude v) - "Return the magnitude of the vec2 V." - (sqrt (+ (* (vec2-x v) (vec2-x v)) (* (vec2-y v) (vec2-y v))))) - (define-inlinable (vec3-magnitude v) "Return the magnitude of the vec3 V." (sqrt (+ (* (vec3-x v) (vec3-x v)) (* (vec3-y v) (vec3-y v)) (* (vec3-z v) (vec3-z v))))) -(define-inlinable (vec2-dot v1 v2) - "Return the dot product of the vec2s V1 and V2." - (+ (* (vec2-x v1) (vec2-x v2)) - (* (vec2-y v1) (vec2-y v2)))) - (define-inlinable (vec3-dot v1 v2) "Return the dot product of the vec3s V1 and V2." (+ (* (vec3-x v1) (vec3-x v2)) (* (vec3-y v1) (vec3-y v2)) (* (vec3-z v1) (vec3-z v2)))) -(define-inlinable (vec2-cross v1 v2) - (- (* (vec2-x v1) (vec2-y v2)) - (* (vec2-y v1) (vec2-x v2)))) - (define-inlinable (vec3-cross! dest v1 v2) (set-vec3! dest (- (* (vec3-y v1) (vec3-z v2)) @@ -265,13 +336,6 @@ polar coordinate (R, THETA) with an arbitrary ORIGIN point." (vec3-cross! vout v1 v2) vout)) -(define-inlinable (vec2-normalize! v) - "Normalize the vec2 V in-place." - (unless (and (zero? (vec2-x v)) (zero? (vec2-y v))) - (let ((m (vec2-magnitude v))) - (set-vec2-x! v (/ (vec2-x v) m)) - (set-vec2-y! v (/ (vec2-y v) m))))) - (define-inlinable (vec3-normalize! v) "Normalize the vec3 V in-place." (unless (and (= (vec3-x v) 0.0) @@ -283,28 +347,12 @@ polar coordinate (R, THETA) with an arbitrary ORIGIN point." (/ (vec3-y v) m) (/ (vec3-z v) m))))) -(define (vec2-normalize v) - "Return the normalized form of the vec2 V." - (with-new-vec2 new - (vec2-copy! v new) - (vec2-normalize! new))) - (define (vec3-normalize v) "Return the normalized form of the vec3 V." (with-new-vec3 new (vec3-copy! v new) (vec3-normalize! new))) -(define-inlinable (vec2-mult! v x) - "Multiply the vec2 V by X, a real number or vec2." - (if (real? x) - (begin - (set-vec2-x! v (* (vec2-x v) x)) - (set-vec2-y! v (* (vec2-y v) x))) - (begin - (set-vec2-x! v (* (vec2-x v) (vec2-x x))) - (set-vec2-y! v (* (vec2-y v) (vec2-y x)))))) - (define-inlinable (vec3-mult! v x) "Multiply the vec3 V by X, a real number or vec3." (if (real? x) @@ -317,16 +365,6 @@ polar coordinate (R, THETA) with an arbitrary ORIGIN point." (set-vec3-y! v (* (vec3-y v) (vec3-y x))) (set-vec3-z! v (* (vec3-z v) (vec3-z x)))))) -(define-inlinable (vec2-add! v x) - "Add X, a real number or vec2, to the vec2 V." - (if (real? x) - (begin - (set-vec2-x! v (+ (vec2-x v) x)) - (set-vec2-y! v (+ (vec2-y v) x))) - (begin - (set-vec2-x! v (+ (vec2-x v) (vec2-x x))) - (set-vec2-y! v (+ (vec2-y v) (vec2-y x)))))) - (define-inlinable (vec3-add! v x) "Add X, a real number or vec3, to the vec3 V." (if (real? x) @@ -339,16 +377,6 @@ polar coordinate (R, THETA) with an arbitrary ORIGIN point." (set-vec3-y! v (+ (vec3-y v) (vec3-y x))) (set-vec3-z! v (+ (vec3-z v) (vec3-z x)))))) -(define-inlinable (vec2-sub! v x) - "Subtract X, a real number or vec2, from the vec2 V." - (if (real? x) - (begin - (set-vec2-x! v (- (vec2-x v) x)) - (set-vec2-y! v (- (vec2-y v) x))) - (begin - (set-vec2-x! v (- (vec2-x v) (vec2-x x))) - (set-vec2-y! v (- (vec2-y v) (vec2-y x)))))) - (define-inlinable (vec3-sub! v x) "Subtract X, a real number or vec3, from the vec3 V." (if (real? x) @@ -361,24 +389,6 @@ polar coordinate (R, THETA) with an arbitrary ORIGIN point." (set-vec3-y! v (- (vec3-y v) (vec3-y x))) (set-vec3-z! v (- (vec3-z v) (vec3-z x)))))) -(define-inlinable (vec2* v x) - "Multiply V by X." - (let ((new (vec2-copy v))) - (vec2-mult! new x) - new)) - -(define-inlinable (vec2+ v x) - "Add X to V." - (let ((new (vec2-copy v))) - (vec2-add! new x) - new)) - -(define-inlinable (vec2- v x) - "Subtract X from V." - (let ((new (vec2-copy v))) - (vec2-sub! new x) - new)) - (define-inlinable (vec3* v x) "Multiply V by X." (let ((new (vec3-copy v))) |