X-Git-Url: https://git.jsancho.org/?p=dungeon-master.git;a=blobdiff_plain;f=mods%2Fdefault%2Ftriangle.scm;fp=mods%2Fdefault%2Ftriangle.scm;h=c11ee1a31542e279b9cb6d127345b3e92e7d3038;hp=343bef3c0e837b1c36626404eba8f5431993e9e7;hb=4e1254800a1c453aba76b8ccd5b632f38a71aed7;hpb=38c209feff157e50f85acf162b5d47419b5b4631

diff --git a/mods/default/triangle.scm b/mods/default/triangle.scm
index 343bef3..c11ee1a 100644
--- a/mods/default/triangle.scm
+++ b/mods/default/triangle.scm
@@ -5,7 +5,8 @@
             triangle?
             triangle-points
             triangle-center
-            triangle-radius))
+            triangle-radius
+            triangle-has-edge))
 
 (define-record-type <triangle>
   (make-raw-triangle points center radius)
@@ -41,3 +42,12 @@
                         (+ y2 (* dy2 t2))))
                (radius (points-distance center tp1)))
           (make-raw-triangle (list tp1 tp2 tp3) center radius))))))
+
+(define (triangle-has-edge triangle a b)
+  (let ((points (triangle-points triangle)))
+    (let ((p1 (car points))
+          (p2 (cadr points))
+          (p3 (caddr points)))
+      (or (and (equal? p1 a) (equal? p2 b))
+          (and (equal? p2 a) (equal? p3 b))
+          (and (equal? p3 a) (equal? p1 b))))))