Voronoi meshes (uncompleted)

[dungeon-master.git] / mods / default / voronoi.scm

diff --git a/mods/default/voronoi.scm b/mods/default/voronoi.scm
new file mode 100644 (file)
index 0000000..f985daa
--- /dev/null
+++ b/mods/default/voronoi.scm
@@ -0,0 +1,38 @@
+(define-module (dungeon-master geom voronoi)
+  #:use-module (srfi srfi-9)
+  #:use-module (dungeon-master geom point)
+  #:use-module (dungeon-master geom triangle))
+
+"https://github.com/watabou/TownGeneratorOS/blob/master/Source/com/watabou/geom/Voronoi.hx"
+
+(define-record-type <voronoi-mesh>
+  (make-raw-voronoi-mesh triangles points frame)
+  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!))
+
+(define (new-voronoi minx miny maxx maxy)
+  (let ((c1 (make-point minx miny))
+        (c2 (make-point minx maxy))
+        (c3 (make-point maxx miny))
+        (c4 (make-point maxx maxy)))
+    (let ((frame (list c1 c2 c3 c4))
+          (points (list c1 c2 c3 c4))
+          (triangles (list (make-triangle c1 c2 c3)
+                           (make-triangle c2 c3 c4))))
+      '())))
+
+(define (make-voronoi-mesh points)
+  (let ((xs (map (lambda (p) (point-x p)) points))
+        (ys (map (lambda (p) (point-y p)) points)))
+    (let ((minx (apply min (cons (expt 10 10) xs)))
+          (miny (apply min (cons (expt 10 10) ys)))
+          (maxx (apply max (cons (- (expt 10 9)) xs)))
+          (maxy (apply max (cons (- (expt 10 9)) ys))))
+      (let ((dx (* (- maxx minx) 0.5))
+            (dy (* (- maxy miny) 0.5)))
+        (new-voronoi (- minx (/ dx 2))
+                     (- miny (/ dy 2))
+                     (+ maxx (/ dx 2))
+                     (+ maxy (/ dy 2)))))))