From efcdd7897930ce2ce2f24ef789c8331b6154527b Mon Sep 17 00:00:00 2001
From: Javier Sancho <jsf@jsancho.org>
Date: Sun, 28 Jul 2019 08:29:06 +0200
Subject: [PATCH] Voronoi mesh (work in progress)

---
 dungeon-master/generators/town.scm    |  2 +-
 dungeon-master/geom/bowyer-watson.scm |  5 ++-
 dungeon-master/geom/voronoi.scm       | 46 +++++++++++++++++++++++----
 3 files changed, 44 insertions(+), 9 deletions(-)

diff --git a/dungeon-master/generators/town.scm b/dungeon-master/generators/town.scm
index 745a642..2f7013a 100644
--- a/dungeon-master/generators/town.scm
+++ b/dungeon-master/generators/town.scm
@@ -31,4 +31,4 @@
   (let* ((sa (* (random:exp) 2 pi))
          (points (get-points (* 8 patches) sa))
          (voronoi (make-voronoi-mesh points)))
-    voronoi))
+    (format #t "~a~%~%~a~%" (voronoi-mesh-frame voronoi) (voronoi-mesh-points voronoi))))
diff --git a/dungeon-master/geom/bowyer-watson.scm b/dungeon-master/geom/bowyer-watson.scm
index e8b9ea5..29bf07c 100644
--- a/dungeon-master/geom/bowyer-watson.scm
+++ b/dungeon-master/geom/bowyer-watson.scm
@@ -6,7 +6,10 @@
   #:use-module (dungeon-master geom triangle)
   #:export (bowyer-watson))
 
-"Compute the Delaunay triangulation using Bowyer–Watson algorithm"
+"
+Compute the Delaunay triangulation using Bowyer–Watson algorithm
+https://en.wikipedia.org/wiki/Bowyer-Watson_algorithm
+"
 
 (define (bowyer-watson vertices)
   (receive (minx miny maxx maxy)
diff --git a/dungeon-master/geom/voronoi.scm b/dungeon-master/geom/voronoi.scm
index 7a9c457..a748634 100644
--- a/dungeon-master/geom/voronoi.scm
+++ b/dungeon-master/geom/voronoi.scm
@@ -9,18 +9,50 @@
             voronoi-mesh?
             voronoi-mesh-triangles
             voronoi-mesh-points
-            voronoi-mesh-frame))
+            voronoi-mesh-frame
+            voronoi-mesh-regions))
 
 "https://github.com/watabou/TownGeneratorOS/blob/master/Source/com/watabou/geom/Voronoi.hx"
 
+(define-record-type <voronoi-region>
+  (make-voronoi-region seed vertices)
+  voronoi-region?
+  (seed voronoi-region-seed)
+  (vertices voronoi-region-vertices))
+
 (define-record-type <voronoi-mesh>
-  (make-raw-voronoi-mesh triangles points frame)
+  (make-raw-voronoi-mesh triangles points frame regions)
   voronoi-mesh?
-  (triangles voronoi-mesh-triangles set-voronoi-mesh-triangles!)
-  (points voronoi-mesh-points set-voronoi-mesh-points!)
-  (frame voronoi-mesh-frame set-voronoi-mesh-frame!))
+  (triangles voronoi-mesh-triangles)
+  (points voronoi-mesh-points)
+  (frame voronoi-mesh-frame)
+  (regions voronoi-mesh-regions))
 
-(define (make-voronoi-mesh vertices)
+(define* (make-voronoi-mesh vertices #:optional (relax-steps 3))
+  ; Delaunay triangulation
   (receive (triangles points frame)
       (bowyer-watson vertices)
-    (make-raw-voronoi-mesh triangles points frame)))
+    ; Relaxing central wards
+    ;; (let relax ((step relax-steps))
+    ;;   (cond ((> step 0)
+    ;;          (relax (- step 1)))
+    ;;         (else
+    ;;          #t)))
+    (make-raw-voronoi-mesh
+     triangles
+     points
+     frame
+     (make-regions points triangles))))
+
+(define* (make-regions points triangles #:optional (regions '()))
+  (cond ((null? points)
+         regions)
+        (else
+         (let* ((p (car points))
+                (vertices (filter
+                           (lambda (tr) (member p (triangle-points tr)))
+                           triangles)))
+           (display p)(newline)
+           (make-regions (cdr points)
+                         triangles
+                         (cons (make-voronoi-region p vertices) regions))))))
-- 
2.39.2