From: Javier Sancho Date: Sun, 28 Jul 2019 07:53:38 +0000 (+0200) Subject: Voronoi relax (work in progress) X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=35202c3698d8858b4d81347253e23fe6d4a01bef;p=dungeon-master.git Voronoi relax (work in progress) --- 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 (make-voronoi-region seed vertices) voronoi-region? (seed voronoi-region-seed) (vertices voronoi-region-vertices)) + +;;; Voronoi mesh + (define-record-type (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))))))