--- a/src/sketch.lisp Thu Aug 11 00:36:30 2016 +0000
+++ b/src/sketch.lisp Wed Aug 17 01:52:14 2016 +0000
@@ -42,7 +42,6 @@
;;;; Box
-
(defparameter *world-exponent* 4)
(defparameter *world-size* (expt 2 *world-exponent*))
@@ -69,7 +68,7 @@
(defun draw-hm (hm ox oy ts)
- (let ((size (- (hm-size hm) 0)))
+ (let ((size (first (array-dimensions hm))))
(in-context
(translate (* ox (* ts size))
(* oy (* ts size)))
@@ -104,8 +103,8 @@
;; Data
(size (1+ (expt 2 4)))
(hm (sand.terrain.diamond-square::diamond-square
- (allocate-heightmap size)))
- (tile-size 5)
+ 5 :tileable t :spread 0.7 :spread-reduction 0.5))
+ (tile-size 3)
;; Pens
(black-pen (make-pen :stroke (rgb 0 0 0) :fill (rgb 0.4 0.4 0.4) :weight 1 :curve-steps 50))
(red-pen (make-pen :stroke (rgb 0.6 0 0) :fill (rgb 0.9 0 0) :weight 1 :curve-steps 50))
@@ -116,12 +115,11 @@
;;
(just-once done
(with-setup
- (in-context
+ (iterate
+ (for x :from 0 :to (floor *width* (* size tile-size)))
(iterate
- (for x :from 0 :to (floor *width* (* size tile-size)))
- (iterate
- (for y :from 0 :to (floor *height* (* size tile-size)))
- (draw-hm hm x y tile-size))))))
+ (for y :from 0 :to (floor *height* (* size tile-size)))
+ (draw-hm hm x y tile-size)))))
;;
)--- a/src/terrain/diamond-square.lisp Thu Aug 11 00:36:30 2016 +0000
+++ b/src/terrain/diamond-square.lisp Wed Aug 17 01:52:14 2016 +0000
@@ -3,14 +3,21 @@
(defvar *size* nil)
+(defvar *tileable* nil)
(defun heightmap-size (heightmap)
(first (array-dimensions heightmap)))
(defun hm-ref (heightmap x y)
(flet ((ref (n)
- (cond ((< -1 n *size*) n)
- (t (mod n *size*)))))
+ (cond ((< n 0)
+ (- (mod n *size*)
+ (if *tileable* 0 1)))
+ ((< n *size*)
+ n)
+ ((>= n *size*)
+ (+ (mod n *size*)
+ (if *tileable* 0 1))))))
(aref heightmap (ref x) (ref y))))
@@ -70,18 +77,23 @@
(ds-diamond heightmap x y radius spread))))
-(defun diamond-square (heightmap)
- (ds-init heightmap)
- (let ((*size* (heightmap-size heightmap))
- (spread 0.8)
- (spread-reduction 0.7))
- (recursively ((radius (floor size 2))
+(defun diamond-square (exponent &key (spread 0.7) (spread-reduction 0.7) (tileable nil))
+ (let* ((*size* (if tileable
+ (expt 2 exponent)
+ (1+ (expt 2 exponent))))
+ (*tileable* tileable)
+ (heightmap (make-array (list *size* *size*)
+ :element-type 'single-float
+ :initial-element 0.0
+ :adjustable nil)))
+ (ds-init heightmap)
+ (recursively ((radius (floor *size* 2))
(spread spread))
(when (>= radius 1)
(ds-squares heightmap radius spread)
(ds-diamonds heightmap radius spread)
(recur (/ radius 2)
- (* spread spread-reduction)))))
- (normalize-heightmap heightmap)
- heightmap)
+ (* spread spread-reduction))))
+ (normalize-heightmap heightmap)
+ heightmap))