--- /dev/null
+(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))
+
+(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))))))