1 (define-module (dungeon-master geom triangle)
2 #:use-module (srfi srfi-9)
3 #:use-module (dungeon-master geom point)
4 #:export (make-triangle
11 (define-record-type <triangle>
12 (make-raw-triangle points center radius)
14 (points triangle-points)
15 (center triangle-center)
16 (radius triangle-radius))
18 (define (make-triangle p1 p2 p3)
19 (let ((s (+ (* (- (point-x p2) (point-x p1))
20 (+ (point-y p2) (point-y p1)))
21 (* (- (point-x p3) (point-x p2))
22 (+ (point-y p3) (point-y p2)))
23 (* (- (point-x p1) (point-x p3))
24 (+ (point-y p1) (point-y p3))))))
26 (tp2 (if (> s 0) p2 p3))
27 (tp3 (if (> s 0) p3 p2)))
28 (let ((x1 (/ (+ (point-x tp1) (point-x tp2)) 2))
29 (y1 (/ (+ (point-y tp1) (point-y tp2)) 2))
30 (x2 (/ (+ (point-x tp2) (point-x tp3)) 2))
31 (y2 (/ (+ (point-y tp2) (point-y tp3)) 2))
32 (dx1 (- (point-y tp1) (point-y tp2)))
33 (dy1 (- (point-x tp2) (point-x tp1)))
34 (dx2 (- (point-y tp2) (point-y tp3)))
35 (dy2 (- (point-x tp3) (point-x tp2))))
36 (let* ((tg1 (/ dy1 dx1))
43 (radius (points-distance center tp1)))
44 (make-raw-triangle (list tp1 tp2 tp3) center radius))))))
46 (define (triangle-has-edge triangle a b)
47 (let ((points (triangle-points triangle)))
48 (let ((p1 (car points))
51 (or (and (equal? p1 a) (equal? p2 b))
52 (and (equal? p2 a) (equal? p3 b))
53 (and (equal? p3 a) (equal? p1 b))))))