From: Javier Sancho Date: Tue, 27 Aug 2019 18:09:18 +0000 (+0200) Subject: Voronoi mesh relax X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=d4dcc4ec9815f1574eb12b3ee20aa0362f77704b;p=dungeon-master.git Voronoi mesh relax --- diff --git a/dungeon-master/geom/point.scm b/dungeon-master/geom/point.scm index 64faaac..3f471eb 100644 --- a/dungeon-master/geom/point.scm +++ b/dungeon-master/geom/point.scm @@ -4,7 +4,9 @@ point? point-x point-y - points-distance)) + points-distance + sum-points + scale-point)) (define-record-type (make-point x y) @@ -16,3 +18,19 @@ (abs (sqrt (+ (expt (- (point-x p1) (point-x p2)) 2) (expt (- (point-y p1) (point-y p2)) 2))))) + +(define (sum-points . points-to-sum) + (let loop ((points points-to-sum) + (x 0) + (y 0)) + (cond ((null? points) + (make-point x y)) + (else + (loop (cdr points) + (+ x (point-x (car points))) + (+ y (point-y (car points)))))))) + +(define (scale-point point scale) + (make-point + (* (point-x point) scale) + (* (point-y point) scale))) diff --git a/dungeon-master/geom/voronoi.scm b/dungeon-master/geom/voronoi.scm index 9217285..66acf9e 100644 --- a/dungeon-master/geom/voronoi.scm +++ b/dungeon-master/geom/voronoi.scm @@ -32,6 +32,14 @@ (> (angle-sign seed c1 c2) 0))) (make-raw-voronoi-region seed (list-sort compare-angles vertices))) +(define (voronoi-region-center region) + (let* ((vertices (voronoi-region-vertices region)) + (centers (map (lambda (v) (triangle-center v)) vertices))) + (scale-point + (apply sum-points centers) + (/ 1 (length vertices))))) + + ;;; Voronoi mesh (define-record-type @@ -42,7 +50,7 @@ (frame voronoi-mesh-frame) (regions voronoi-mesh-regions)) -(define* (make-voronoi-mesh vertices #:optional (relax-steps 3)) +(define (make-voronoi-mesh vertices) ;; Delaunay triangulation (receive (triangles points frame) (bowyer-watson vertices) @@ -86,9 +94,27 @@ ordered-regions))) filtered-regions)) -(define* (voronoi-mesh-relax voronoi #:optional (to-relax '())) - (let ((regions (partitioning voronoi))) - voronoi)) +(define* (voronoi-mesh-relax voronoi #:optional (points-to-relax '())) + (let ((regions + (map + (lambda (r) (cons (voronoi-region-seed r) (voronoi-region-center r))) + (partitioning voronoi))) + (points + (filter + (lambda (p) (not (member p (voronoi-mesh-frame voronoi)))) + (voronoi-mesh-points voronoi))) + (to-relax + (if (null? points-to-relax) + (voronoi-mesh-points voronoi) + points-to-relax))) + (make-voronoi-mesh + (map + (lambda (point) + (let ((center (assoc-ref regions point))) + (if (and center (member point to-relax)) + center + point))) + points)))) (define (make-regions points triangles) (map-in-order