mods/default/voronoi.scm

   1 (define-module (dungeon-master geom voronoi)
   2   #:use-module (srfi srfi-9)
   3   #:use-module (dungeon-master geom point)
   4   #:use-module (dungeon-master geom triangle))
   5
   6 "https://github.com/watabou/TownGeneratorOS/blob/master/Source/com/watabou/geom/Voronoi.hx"
   7
   8 (define-record-type <voronoi-mesh>
   9   (make-raw-voronoi-mesh triangles points frame)
  10   voronoi-mesh?
  11   (triangles voronoi-mesh-triangles set-voronoi-mesh-triangles!)
  12   (points voronoi-mesh-points set-voronoi-mesh-points!)
  13   (frame voronoi-mesh-frame set-voronoi-mesh-frame!))
  14
  15 (define (new-voronoi minx miny maxx maxy)
  16   (let ((c1 (make-point minx miny))
  17         (c2 (make-point minx maxy))
  18         (c3 (make-point maxx miny))
  19         (c4 (make-point maxx maxy)))
  20     (let ((frame (list c1 c2 c3 c4))
  21           (points (list c1 c2 c3 c4))
  22           (triangles (list (make-triangle c1 c2 c3)
  23                            (make-triangle c2 c3 c4))))
  24       '())))
  25
  26 (define (make-voronoi-mesh points)
  27   (let ((xs (map (lambda (p) (point-x p)) points))
  28         (ys (map (lambda (p) (point-y p)) points)))
  29     (let ((minx (apply min (cons (expt 10 10) xs)))
  30           (miny (apply min (cons (expt 10 10) ys)))
  31           (maxx (apply max (cons (- (expt 10 9)) xs)))
  32           (maxy (apply max (cons (- (expt 10 9)) ys))))
  33       (let ((dx (* (- maxx minx) 0.5))
  34             (dy (* (- maxy miny) 0.5)))
  35         (new-voronoi (- minx (/ dx 2))
  36                      (- miny (/ dy 2))
  37                      (+ maxx (/ dx 2))
  38                      (+ maxy (/ dy 2)))))))