dungeon-master/geom/triangle.scm

   1 (define-module (dungeon-master geom triangle)
   2   #:use-module (ice-9 receive)
   3   #:use-module (srfi srfi-9)
   4   #:use-module (dungeon-master geom point)
   5   #:export (make-triangle
   6             triangle?
   7             triangle-points
   8             triangle-center
   9             triangle-radius
  10             triangle-has-edge))
  11
  12 (define-record-type <triangle>
  13   (make-raw-triangle points center radius)
  14   triangle?
  15   (points triangle-points)
  16   (center triangle-center)
  17   (radius triangle-radius))
  18
  19 (define (make-triangle p1 p2 p3)
  20   (let ((center (circumcenter p1 p2 p3)))
  21     (make-raw-triangle
  22      (list p1 p2 p3)
  23      center
  24      (points-distance center p1))))
  25
  26 (define (circumcenter p1 p2 p3)
  27   (receive (a b c)
  28       (perpendicular-line-from-points p1 p2)
  29     (receive (e f g)
  30         (perpendicular-line-from-points p2 p3)
  31       (let ((determinant (- (* a f) (* e b))))
  32         (make-point
  33          (/ (- (* f c) (* b g)) determinant)
  34          (/ (- (* a g) (* e c)) determinant))))))
  35
  36 (define (perpendicular-line-from-points p1 p2)
  37   (let ((x1 (point-x p1))
  38         (y1 (point-y p1))
  39         (x2 (point-x p2))
  40         (y2 (point-y p2)))
  41     (let* ((a (- y2 y1))
  42            (b (- x1 x2))
  43            (c (+ (* a x1) (* b y2))))
  44       (let ((mid-x (/ (+ x1 x2) 2))
  45             (mid-y (/ (+ y1 y2) 2)))
  46         (values (- b)
  47                 a
  48                 (+ (* (- b) mid-x) (* a mid-y)))))))
  49
  50 (define (triangle-has-edge triangle a b)
  51   (let ((points (triangle-points triangle)))
  52     (let ((p1 (car points))
  53           (p2 (cadr points))
  54           (p3 (caddr points)))
  55       (or (and (equal? p1 a) (equal? p2 b))
  56           (and (equal? p1 b) (equal? p2 a))
  57           (and (equal? p2 a) (equal? p3 b))
  58           (and (equal? p2 b) (equal? p3 a))
  59           (and (equal? p3 a) (equal? p1 b))
  60           (and (equal? p3 b) (equal? p1 a))))))