dungeon-master/geom/voronoi.scm

   1 (define-module (dungeon-master geom voronoi)
   2   #:use-module (ice-9 receive)
   3   #:use-module (srfi srfi-1)
   4   #:use-module (srfi srfi-9)
   5   #:use-module (dungeon-master geom point)
   6   #:use-module (dungeon-master geom triangle)
   7   #:use-module (dungeon-master geom bowyer-watson)
   8   #:export (make-voronoi-mesh
   9             voronoi-mesh?
  10             voronoi-mesh-triangles
  11             voronoi-mesh-points
  12             voronoi-mesh-frame
  13             voronoi-mesh-regions))
  14
  15 "https://github.com/watabou/TownGeneratorOS/blob/master/Source/com/watabou/geom/Voronoi.hx"
  16
  17 (define-record-type <voronoi-region>
  18   (make-voronoi-region seed vertices)
  19   voronoi-region?
  20   (seed voronoi-region-seed)
  21   (vertices voronoi-region-vertices))
  22
  23 (define-record-type <voronoi-mesh>
  24   (make-raw-voronoi-mesh triangles points frame regions)
  25   voronoi-mesh?
  26   (triangles voronoi-mesh-triangles)
  27   (points voronoi-mesh-points)
  28   (frame voronoi-mesh-frame)
  29   (regions voronoi-mesh-regions))
  30
  31 (define* (make-voronoi-mesh vertices #:optional (relax-steps 3))
  32   ; Delaunay triangulation
  33   (receive (triangles points frame)
  34       (bowyer-watson vertices)
  35     ; Relaxing central wards
  36     ;; (let relax ((step relax-steps))
  37     ;;   (cond ((> step 0)
  38     ;;          (relax (- step 1)))
  39     ;;         (else
  40     ;;          #t)))
  41     (make-raw-voronoi-mesh
  42      triangles
  43      points
  44      frame
  45      (make-regions points triangles))))
  46
  47 (define* (make-regions points triangles #:optional (regions '()))
  48   (cond ((null? points)
  49          regions)
  50         (else
  51          (let* ((p (car points))
  52                 (vertices (filter
  53                            (lambda (tr) (member p (triangle-points tr)))
  54                            triangles)))
  55            (display p)(newline)
  56            (make-regions (cdr points)
  57                          triangles
  58                          (cons (make-voronoi-region p vertices) regions))))))