X-Git-Url: https://git.jsancho.org/?p=dungeon-master.git;a=blobdiff_plain;f=dungeon-master%2Fgeom%2Ftriangle.scm;fp=dungeon-master%2Fgeom%2Ftriangle.scm;h=0000000000000000000000000000000000000000;hp=6f7ccf8634bd6032a83219de46d3bf0912a9229d;hb=8f36ecdca1766ddd2a177fa46dc885c7f8e14130;hpb=4fce641cc077d18f972e250d2fe3be5067618127 diff --git a/dungeon-master/geom/triangle.scm b/dungeon-master/geom/triangle.scm deleted file mode 100644 index 6f7ccf8..0000000 --- a/dungeon-master/geom/triangle.scm +++ /dev/null @@ -1,77 +0,0 @@ -;;; Dungeon Master --- RPG Adventure Generator -;;; Copyright © 2019 Javier Sancho -;;; -;;; Dungeon Master is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; Dungeon Master is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with Dungeon Master. If not, see . - - -(define-module (dungeon-master geom triangle) - #:use-module (ice-9 receive) - #: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 - (make-raw-triangle points center radius) - triangle? - (points triangle-points) - (center triangle-center) - (radius triangle-radius)) - -(define (make-triangle p1 p2 p3) - (let ((center (circumcenter p1 p2 p3))) - (make-raw-triangle - (list p1 p2 p3) - center - (points-distance center p1)))) - -(define (circumcenter p1 p2 p3) - (receive (a b c) - (perpendicular-line-from-points p1 p2) - (receive (e f g) - (perpendicular-line-from-points p2 p3) - (let ((determinant (- (* a f) (* e b)))) - (make-point - (/ (- (* f c) (* b g)) determinant) - (/ (- (* a g) (* e c)) determinant)))))) - -(define (perpendicular-line-from-points p1 p2) - (let ((x1 (point-x p1)) - (y1 (point-y p1)) - (x2 (point-x p2)) - (y2 (point-y p2))) - (let* ((a (- y2 y1)) - (b (- x1 x2)) - (c (+ (* a x1) (* b y2)))) - (let ((mid-x (/ (+ x1 x2) 2)) - (mid-y (/ (+ y1 y2) 2))) - (values (- b) - a - (+ (* (- b) mid-x) (* a mid-y))))))) - -(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? p1 b) (equal? p2 a)) - (and (equal? p2 a) (equal? p3 b)) - (and (equal? p2 b) (equal? p3 a)) - (and (equal? p3 a) (equal? p1 b)) - (and (equal? p3 b) (equal? p1 a))))))