Testing vector components

engine/components.scm

@@ -54,6 +54,22 @@
   (assert (number? y))
   ((rtd-mutator (record-rtd component) 'y) component y))
 
+;; Export vector functions
+(export vector-= vector-+ vector-- vector-* vector-/
+	vector-magnitude vector-normalize)
+
+;; TODO: make this function accept any number of vectors
+(define (vector-= 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)) '(vector2?)))
+  (cond
+   ((vector2? vec1)
+    (and (= (vector-x vec1) (vector-x vec2))
+	 (= (vector-y vec1) (vector-y vec2))))))
+
 ;; TODO: make this function accept any number of vectors
 (define (vector-+ vec1 vec2)
   (assert (and (record? vec1)
@@ -107,8 +123,8 @@
   (assert (any (lambda (pred) (pred vec)) '(vector2?)))
   (cond
    ((vector2? vec)
-    (sqrt (expt (vector-x vec) 2)
-	  (expt (vector-y vec) 2)))))
+    (sqrt (+ (expt (vector-x vec) 2)
+	     (expt (vector-y vec) 2))))))
 
 ;; Normalization
 (define (vector-normalize vec)

test/components.scm

@@ -0,0 +1,24 @@
+(module (test components) ()
+(import scheme
+	(chicken base)
+	(engine core)
+	(engine components core)
+	(srfi 78)
+	(srfi 99))
+
+(define v1 (make-vector2 0 0))
+(define v2 (make-vector2 10 10))
+
+(check (vector-= v2 (make-vector2 10 10)) => #t)
+(check (vector-= (make-vector2 20 20)
+		 (vector-+ v2 (make-vector2 10 10))) => #t)
+(check (vector-= v1
+		 (vector-- v2 (make-vector2 10 10))) => #t)
+(check (vector-= (make-vector2 100 100)
+		 (vector-* v2 (make-vector2 10 10))) => #t)
+(check (vector-= (make-vector2 1 1)
+		 (vector-/ v2 (make-vector2 10 10))) => #t)
+(check (vector-magnitude (make-vector 100 0)) => 100)
+(check (vector-= (make-vector 1 0)
+		 (vector-normalize (make-vector 100 0))) => #t)
+)