owverwrite face-normal-vector, see euslisp/EusLisp#21

k-okada · Jun 24, 2014 · 23e85ee · 23e85ee
1 parent 454bde8
commit 23e85ee
Showing 1 changed file with 18 additions and 0 deletions.
diff --git a/irteus/test/geo.l b/irteus/test/geo.l
@@ -2,6 +2,24 @@
 
 (init-unit-test)
 
+(in-package "GEO")
+(defun face-normal-vector (vertices)
+  (let* ((v1 (first vertices)) (v2) (vlist (rest vertices))
+         (v (float-vector 0 0 0))
+         (normal (float-vector 0 0 0)))
+    (while vlist
+      (setq v2 (pop vlist))
+      (v+ (v* v1 v2 v) normal normal)
+      (setq v1 v2))
+    (setq v2 (car vertices))
+    (v+ (v* v1 v2 v) normal normal)
+    (normalize-vector normal normal)) )
+
+(defmethod polygon
+  (:reset-normal ()
+                 (setq normal (face-normal-vector (rest vertices))
+                       distance (- (v. normal (car vertices))))))
+(in-package "USER")
 
 (deftest test-body+
   (let (bottom-frame