Tests for vector functions
This commit is contained in:
parent
8dbf44a9f0
commit
65a60a2a65
3 changed files with 58 additions and 1 deletions
|
|
@ -56,7 +56,8 @@
|
||||||
|
|
||||||
;; Export vector functions
|
;; Export vector functions
|
||||||
(export vector-= vector-+ vector-- vector-* vector-/
|
(export vector-= vector-+ vector-- vector-* vector-/
|
||||||
vector-magnitude vector-normalize)
|
vector-magnitude vector-normalize vector-dot
|
||||||
|
vector-angle-between)
|
||||||
|
|
||||||
;; TODO: make this function accept any number of vectors
|
;; TODO: make this function accept any number of vectors
|
||||||
(define (vector-= vec1 vec2)
|
(define (vector-= vec1 vec2)
|
||||||
|
|
@ -126,6 +127,29 @@
|
||||||
(sqrt (+ (expt (vector-x vec) 2)
|
(sqrt (+ (expt (vector-x vec) 2)
|
||||||
(expt (vector-y vec) 2))))))
|
(expt (vector-y vec) 2))))))
|
||||||
|
|
||||||
|
(define (vector-dot vec1 vec2)
|
||||||
|
(assert (and (record? vec1)
|
||||||
|
(record? vec2)))
|
||||||
|
(assert (eq? (rtd-name (record-rtd vec1))
|
||||||
|
(rtd-name (record-rtd vec2))))
|
||||||
|
(assert (any (lambda (pred) (pred vec1)) (list vector2?)))
|
||||||
|
(cond
|
||||||
|
((vector2? vec1)
|
||||||
|
(+ (* (vector-x vec1) (vector-x vec2))
|
||||||
|
(* (vector-y vec1) (vector-y vec2))))))
|
||||||
|
|
||||||
|
(define (vector-angle-between vec1 vec2)
|
||||||
|
(assert (and (record? vec1)
|
||||||
|
(record? vec2)))
|
||||||
|
(assert (eq? (rtd-name (record-rtd vec1))
|
||||||
|
(rtd-name (record-rtd vec2))))
|
||||||
|
(assert (any (lambda (pred) (pred vec1)) (list vector2?)))
|
||||||
|
(cond
|
||||||
|
((vector2? vec1)
|
||||||
|
(acos (/ (vector-dot vec1 vec2)
|
||||||
|
(* (vector-magnitude vec1)
|
||||||
|
(vector-magnitude vec2)))))))
|
||||||
|
|
||||||
;; Normalization
|
;; Normalization
|
||||||
(define (vector-normalize vec)
|
(define (vector-normalize vec)
|
||||||
(assert (any (lambda (pred) (pred vec)) (list vector2?))) ;; TODO: This assertion should be moved out of here
|
(assert (any (lambda (pred) (pred vec)) (list vector2?))) ;; TODO: This assertion should be moved out of here
|
||||||
|
|
|
||||||
27
engine/math.scm
Normal file
27
engine/math.scm
Normal file
|
|
@ -0,0 +1,27 @@
|
||||||
|
(module (engine math) ()
|
||||||
|
(import scheme
|
||||||
|
(chicken base)
|
||||||
|
(chicken module))
|
||||||
|
|
||||||
|
(export PI PI/2)
|
||||||
|
(define PI
|
||||||
|
3.141592653589793238462643383279502884197169399375105820974944592307816406286)
|
||||||
|
|
||||||
|
(define PI/2
|
||||||
|
(/ PI 2))
|
||||||
|
|
||||||
|
(export rad-to-deg deg-to-rad)
|
||||||
|
;; Radians and degrees conversion
|
||||||
|
(define (rad-to-deg rad)
|
||||||
|
(* rad
|
||||||
|
(/ 180 PI)))
|
||||||
|
(define (deg-to-rad deg)
|
||||||
|
(* deg
|
||||||
|
(/ PI 180)))
|
||||||
|
|
||||||
|
(export *float-precision* approx-=)
|
||||||
|
(define *float-precision* (make-parameter 0.001))
|
||||||
|
;; Approximately equal - for real number comparison
|
||||||
|
(define (approx-= x y)
|
||||||
|
(< (abs (- x y)) (*float-precision*)))
|
||||||
|
)
|
||||||
|
|
@ -3,6 +3,7 @@
|
||||||
(chicken base)
|
(chicken base)
|
||||||
(engine core)
|
(engine core)
|
||||||
(engine components core)
|
(engine components core)
|
||||||
|
(engine math)
|
||||||
(srfi 78)
|
(srfi 78)
|
||||||
(srfi 99))
|
(srfi 99))
|
||||||
|
|
||||||
|
|
@ -21,4 +22,9 @@
|
||||||
(check (vector-magnitude (make-vector2 100 0)) => 100)
|
(check (vector-magnitude (make-vector2 100 0)) => 100)
|
||||||
(check (vector-= (make-vector2 1 0)
|
(check (vector-= (make-vector2 1 0)
|
||||||
(vector-normalize (make-vector2 100 0))) => #t)
|
(vector-normalize (make-vector2 100 0))) => #t)
|
||||||
|
(check (vector-dot (make-vector2 1 2)
|
||||||
|
(make-vector2 3 4)) => 11)
|
||||||
|
(check (rad-to-deg
|
||||||
|
(vector-angle-between (make-vector2 1 2)
|
||||||
|
(make-vector2 3 4))) (=> approx-=) 10.305)
|
||||||
)
|
)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue