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=0000000000000000000000000000000000000000;hp=c11ee1a31542e279b9cb6d127345b3e92e7d3038;hb=695ecf94f5bb10ced4e66b0b4d036de9965c02ca;hpb=4e1254800a1c453aba76b8ccd5b632f38a71aed7

diff --git a/mods/default/triangle.scm b/mods/default/triangle.scm
deleted file mode 100644
index c11ee1a..0000000
--- a/mods/default/triangle.scm
+++ /dev/null
@@ -1,53 +0,0 @@
-(define-module (dungeon-master geom triangle)
-  #:use-module (srfi srfi-9)
-  #:use-module (dungeon-master geom point)
-  #:export (make-triangle
-            triangle?
-            triangle-points
-            triangle-center
-            triangle-radius
-            triangle-has-edge))
-
-(define-record-type <triangle>
-  (make-raw-triangle points center radius)
-  triangle?
-  (points triangle-points)
-  (center triangle-center)
-  (radius triangle-radius))
-
-(define (make-triangle p1 p2 p3)
-  (let ((s (+ (* (- (point-x p2) (point-x p1))
-                 (+ (point-y p2) (point-y p1)))
-              (* (- (point-x p3) (point-x p2))
-                 (+ (point-y p3) (point-y p2)))
-              (* (- (point-x p1) (point-x p3))
-                 (+ (point-y p1) (point-y p3))))))
-    (let ((tp1 p1)
-          (tp2 (if (> s 0) p2 p3))
-          (tp3 (if (> s 0) p3 p2)))
-      (let ((x1 (/ (+ (point-x tp1) (point-x tp2)) 2))
-            (y1 (/ (+ (point-y tp1) (point-y tp2)) 2))
-            (x2 (/ (+ (point-x tp2) (point-x tp3)) 2))
-            (y2 (/ (+ (point-y tp2) (point-y tp3)) 2))
-            (dx1 (- (point-y tp1) (point-y tp2)))
-            (dy1 (- (point-x tp2) (point-x tp1)))
-            (dx2 (- (point-y tp2) (point-y tp3)))
-            (dy2 (- (point-x tp3) (point-x tp2))))
-        (let* ((tg1 (/ dy1 dx1))
-               (t2 (/ (- (- y1 y2)
-                         (* (- (x1 x2)) tg1))
-                      (- dy2 (* dx2 tg1))))
-               (center (make-point
-                        (+ x2 (* dx2 t2))
-                        (+ 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))))))