From 35202c3698d8858b4d81347253e23fe6d4a01bef Mon Sep 17 00:00:00 2001
From: Javier Sancho <jsf@jsancho.org>
Date: Sun, 28 Jul 2019 09:53:38 +0200
Subject: [PATCH] Voronoi relax (work in progress)

---
 dungeon-master/generators/town.scm    | 20 ++++++++++++++++----
 dungeon-master/geom/bowyer-watson.scm |  2 +-
 dungeon-master/geom/voronoi.scm       | 23 +++++++++++++----------
 3 files changed, 30 insertions(+), 15 deletions(-)

diff --git a/dungeon-master/generators/town.scm b/dungeon-master/generators/town.scm
index 2f7013a..e8e6d95 100644
--- a/dungeon-master/generators/town.scm
+++ b/dungeon-master/generators/town.scm
@@ -7,6 +7,7 @@
   (= (random 2) 1))
 
 (define pi 3.141592654)
+(define relax-steps 3)
 
 (define (generate patches)
   "City generator from https://github.com/watabou/TownGeneratorOS/blob/master/Source/com/watabou/towngenerator/building/Model.hx"
@@ -14,7 +15,7 @@
   (when (= patches -1) (set! patches 15))
   (build-patches patches))
 
-(define (build-patches patches)
+(define (build-patches n-patches)
   (define* (get-points n seed #:optional (l '()))
     (cond ((> n 0)
            (let* ((a (+ seed (* (sqrt n) 5)))
@@ -28,7 +29,18 @@
           (else
            l)))
 
+  (define (relax voronoi n step)
+    "Relaxing central wards"
+    (cond ((> step 0)
+           (let* ((voronoi-points (voronoi-mesh-points voronoi))
+                  (n-points (length voronoi-points))
+                  (to-relax (cons (list-ref voronoi-points (- n-points n-patches))
+                                  (list-tail voronoi-points (- n-points 3)))))
+             (relax (voronoi-mesh-relax voronoi to-relax) n (- step 1))))
+          (else
+           voronoi)))
+
   (let* ((sa (* (random:exp) 2 pi))
-         (points (get-points (* 8 patches) sa))
-         (voronoi (make-voronoi-mesh points)))
-    (format #t "~a~%~%~a~%" (voronoi-mesh-frame voronoi) (voronoi-mesh-points voronoi))))
+         (points (get-points (* 8 n-patches) sa))
+         (voronoi (relax (make-voronoi-mesh points) n-patches relax-steps)))
+    "end"))
diff --git a/dungeon-master/geom/bowyer-watson.scm b/dungeon-master/geom/bowyer-watson.scm
index 29bf07c..7283b6f 100644
--- a/dungeon-master/geom/bowyer-watson.scm
+++ b/dungeon-master/geom/bowyer-watson.scm
@@ -21,7 +21,7 @@ https://en.wikipedia.org/wiki/Bowyer-Watson_algorithm
       (let ((frame (list c1 c2 c3 c4)))
         (receive (points triangles)
             (calculate-triangulation
-             (list c1 c2 c3 c4)
+             (list c4 c3 c2 c1)
              (list (make-triangle c1 c2 c3)
                    (make-triangle c2 c3 c4))
              vertices)
diff --git a/dungeon-master/geom/voronoi.scm b/dungeon-master/geom/voronoi.scm
index a748634..3f55946 100644
--- a/dungeon-master/geom/voronoi.scm
+++ b/dungeon-master/geom/voronoi.scm
@@ -10,16 +10,22 @@
             voronoi-mesh-triangles
             voronoi-mesh-points
             voronoi-mesh-frame
-            voronoi-mesh-regions))
+            voronoi-mesh-regions
+            voronoi-mesh-relax))
 
 "https://github.com/watabou/TownGeneratorOS/blob/master/Source/com/watabou/geom/Voronoi.hx"
 
+;;; Voronoi mesh region
+
 (define-record-type <voronoi-region>
   (make-voronoi-region seed vertices)
   voronoi-region?
   (seed voronoi-region-seed)
   (vertices voronoi-region-vertices))
 
+
+;;; Voronoi mesh
+
 (define-record-type <voronoi-mesh>
   (make-raw-voronoi-mesh triangles points frame regions)
   voronoi-mesh?
@@ -32,18 +38,15 @@
   ; Delaunay triangulation
   (receive (triangles points frame)
       (bowyer-watson vertices)
-    ; 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* (voronoi-mesh-relax voronoi #:optional (to-relax '()))
+  voronoi)
+
 (define* (make-regions points triangles #:optional (regions '()))
   (cond ((null? points)
          regions)
@@ -51,8 +54,8 @@
          (let* ((p (car points))
                 (vertices (filter
                            (lambda (tr) (member p (triangle-points tr)))
-                           triangles)))
-           (display p)(newline)
+                           triangles))
+                (region (make-voronoi-region p vertices)))
            (make-regions (cdr points)
                          triangles
-                         (cons (make-voronoi-region p vertices) regions))))))
+                         (alist-cons p region regions))))))
-- 
2.39.5