Voronoi meshes (uncompleted)

diff --git a/mods/default/point.scm b/mods/default/point.scm
new file mode 100644 (file)
index 0000000..6ce8d64
--- /dev/null
+++ b/mods/default/point.scm
@@ -0,0 +1,17 @@
+(define-module (dungeon-master geom point)
+  #:use-module (srfi srfi-9)
+  #:export (make-point
+            point?
+            point-x
+            point-y))
+
+(define-record-type <point>
+  (make-point x y)
+  point?
+  (x point-x)
+  (y point-y))
+
+(define (points-distance p1 p2)
+  (abs
+   (sqrt (+ (expt (- (point-x p1) (point-x p2)) 2)
+            (expt (- (point-y p1) (point-y p2)) 2)))))

diff --git a/mods/default/triangle.scm b/mods/default/triangle.scm
new file mode 100644 (file)
index 0000000..343bef3
--- /dev/null
+++ b/mods/default/triangle.scm
@@ -0,0 +1,43 @@
+(define-module (dungeon-master geom triangle)
+  #:use-module (srfi srfi-9)
+  #:use-module (dungeon-master geom point)
+  #:export (make-triangle
+            triangle?
+            triangle-points
+            triangle-center
+            triangle-radius))
+
+(define-record-type <triangle>
+  (make-raw-triangle points center radius)
+  triangle?
+  (points triangle-points)
+  (center triangle-center)
+  (radius triangle-radius))
+
+(define (make-triangle p1 p2 p3)
+  (let ((s (+ (* (- (point-x p2) (point-x p1))
+                 (+ (point-y p2) (point-y p1)))
+              (* (- (point-x p3) (point-x p2))
+                 (+ (point-y p3) (point-y p2)))
+              (* (- (point-x p1) (point-x p3))
+                 (+ (point-y p1) (point-y p3))))))
+    (let ((tp1 p1)
+          (tp2 (if (> s 0) p2 p3))
+          (tp3 (if (> s 0) p3 p2)))
+      (let ((x1 (/ (+ (point-x tp1) (point-x tp2)) 2))
+            (y1 (/ (+ (point-y tp1) (point-y tp2)) 2))
+            (x2 (/ (+ (point-x tp2) (point-x tp3)) 2))
+            (y2 (/ (+ (point-y tp2) (point-y tp3)) 2))
+            (dx1 (- (point-y tp1) (point-y tp2)))
+            (dy1 (- (point-x tp2) (point-x tp1)))
+            (dx2 (- (point-y tp2) (point-y tp3)))
+            (dy2 (- (point-x tp3) (point-x tp2))))
+        (let* ((tg1 (/ dy1 dx1))
+               (t2 (/ (- (- y1 y2)
+                         (* (- (x1 x2)) tg1))
+                      (- dy2 (* dx2 tg1))))
+               (center (make-point
+                        (+ x2 (* dx2 t2))
+                        (+ y2 (* dy2 t2))))
+               (radius (points-distance center tp1)))
+          (make-raw-triangle (list tp1 tp2 tp3) center radius))))))

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)))))))

diff --git a/src/mods.cpp b/src/mods.cpp
index 63a3a8b3321af917d693764935d6f1686e109291..6d39699d18ff2dd53b274580af16f22ac5583b89 100644 (file)
--- a/src/mods.cpp
+++ b/src/mods.cpp
@@ -11,7 +11,7 @@ SCM register_scene_generator(SCM name, SCM type, SCM proc)
   SceneGenerator generator {scm_to_locale_string(name), scm_to_locale_string(type), proc };
   register_generator(generator);
   printf ("Register: %s (%s)\n", generator.name.c_str(), generator.type.c_str());
-  //scm_call_1(proc, scm_from_int(-1));
+  scm_call_1(proc, scm_from_int(-1));
   return SCM_UNSPECIFIED;
 }