diff --git a/terranostra.lisp b/terranostra.lisp index d25e20c..ea802f5 100644 --- a/terranostra.lisp +++ b/terranostra.lisp @@ -20,6 +20,7 @@ (defun init-matrix (size) "Create a square matrix of empty patches" + (format t "~&Creating a ~Sx~S world matrix." size size) (do ((y 0 (1+ y)) (world NIL) (row NIL NIL)) ((= y size) world) (dotimes (x size) @@ -86,7 +87,7 @@ (defun create-mountains (world &optional (montaneity 2)) "Create mountains and hills. Montaneity determines number and height." - (do ((n 0 (1+ n)) (npeaks (random (* (/ montaneity 100) + (do ((n 0 (1+ n)) (npeaks (random (* (/ montaneity 500) (* (length world) (length world)))))) ((= n npeaks)) @@ -99,30 +100,33 @@ (setf (patch-alt (coord xcoord ycoord world)) height) (do ((dist 1 (1+ dist)) (levelp NIL)) (levelp) + (setf levelp T) (do ((x (- xcoord dist) (1+ x))) ((> x (+ xcoord dist))) (do* ((y (- ycoord dist) (1+ y)) (p (coord x y world) (coord x y world)) - (np (when p (neighbour p (dir2patch x y xcoord ycoord))) - (when p (neighbour p (dir2patch x y xcoord ycoord))))) + (np (when p (neighbour p + (dir2patch x y xcoord ycoord) world)) + (when p (neighbour p + (dir2patch x y xcoord ycoord) world)))) ((> y (+ ycoord dist))) (when (and p (or (= (abs (- xcoord x)) dist) (= (abs (- ycoord y)) dist))) (let ((new-alt (- (patch-alt np) (random (* montaneity 5))))) - (if (> new-alt *base-height*) - (progn (setf (patch-alt p) new-alt) - (setf levelp NIL)) - (setf levelp T)))) - (unless p (setf levelp T)))))) ;boundary check + (when (and (> new-alt *base-height*) + (> new-alt (patch-alt p))) + (setf (patch-alt p) new-alt) + (setf levelp NIL)))))))) (defun create-valleys (world &optional (aqueousness 5)) "Create valleys through streams. Aqueousness determines their number." - (do ((n 0 (1+ n)) (nstreams (random (* (/ aqueousness 100) - (* (length world) - (length world)))))) + (do* ((n 0 (1+ n)) (size (length world)) + (x (random size) (random size)) (y (random size) (random size)) + (nstreams (random (* (/ aqueousness 100) (* size size))))) ((= n nstreams)) - (create-stream (random (length world)) (random (length world)) world))) + (format t "~&Creating a stream from ~S/~S" x y) + (create-stream x y world))) (defun create-stream (x y world) "Create a stream, starting at x/y" @@ -155,6 +159,13 @@ (create-stream (first (patch-pos nextpatch)) (second (patch-pos nextpatch)) world))) +(defun create-world (size name &optional (world *world*)) + (setf world NIL) + (setf world (init-matrix size)) + (create-mountains world) + (create-valleys world) + (save-topography name world)) ;; Initialize the random state (which would otherwise not be very random...) (setf *random-state* (make-random-state t)) + diff --git a/terranostra.lisp b/terranostra.lisp index d25e20c..ea802f5 100644 --- a/terranostra.lisp +++ b/terranostra.lisp @@ -20,6 +20,7 @@ (defun init-matrix (size) "Create a square matrix of empty patches" + (format t "~&Creating a ~Sx~S world matrix." size size) (do ((y 0 (1+ y)) (world NIL) (row NIL NIL)) ((= y size) world) (dotimes (x size) @@ -86,7 +87,7 @@ (defun create-mountains (world &optional (montaneity 2)) "Create mountains and hills. Montaneity determines number and height." - (do ((n 0 (1+ n)) (npeaks (random (* (/ montaneity 100) + (do ((n 0 (1+ n)) (npeaks (random (* (/ montaneity 500) (* (length world) (length world)))))) ((= n npeaks)) @@ -99,30 +100,33 @@ (setf (patch-alt (coord xcoord ycoord world)) height) (do ((dist 1 (1+ dist)) (levelp NIL)) (levelp) + (setf levelp T) (do ((x (- xcoord dist) (1+ x))) ((> x (+ xcoord dist))) (do* ((y (- ycoord dist) (1+ y)) (p (coord x y world) (coord x y world)) - (np (when p (neighbour p (dir2patch x y xcoord ycoord))) - (when p (neighbour p (dir2patch x y xcoord ycoord))))) + (np (when p (neighbour p + (dir2patch x y xcoord ycoord) world)) + (when p (neighbour p + (dir2patch x y xcoord ycoord) world)))) ((> y (+ ycoord dist))) (when (and p (or (= (abs (- xcoord x)) dist) (= (abs (- ycoord y)) dist))) (let ((new-alt (- (patch-alt np) (random (* montaneity 5))))) - (if (> new-alt *base-height*) - (progn (setf (patch-alt p) new-alt) - (setf levelp NIL)) - (setf levelp T)))) - (unless p (setf levelp T)))))) ;boundary check + (when (and (> new-alt *base-height*) + (> new-alt (patch-alt p))) + (setf (patch-alt p) new-alt) + (setf levelp NIL)))))))) (defun create-valleys (world &optional (aqueousness 5)) "Create valleys through streams. Aqueousness determines their number." - (do ((n 0 (1+ n)) (nstreams (random (* (/ aqueousness 100) - (* (length world) - (length world)))))) + (do* ((n 0 (1+ n)) (size (length world)) + (x (random size) (random size)) (y (random size) (random size)) + (nstreams (random (* (/ aqueousness 100) (* size size))))) ((= n nstreams)) - (create-stream (random (length world)) (random (length world)) world))) + (format t "~&Creating a stream from ~S/~S" x y) + (create-stream x y world))) (defun create-stream (x y world) "Create a stream, starting at x/y" @@ -155,6 +159,13 @@ (create-stream (first (patch-pos nextpatch)) (second (patch-pos nextpatch)) world))) +(defun create-world (size name &optional (world *world*)) + (setf world NIL) + (setf world (init-matrix size)) + (create-mountains world) + (create-valleys world) + (save-topography name world)) ;; Initialize the random state (which would otherwise not be very random...) (setf *random-state* (make-random-state t)) + diff --git a/visualize.R b/visualize.R index e0c5dfb..4dceb27 100644 --- a/visualize.R +++ b/visualize.R @@ -13,11 +13,11 @@ palette = terrain.colors(range(w)[2]-range(w)[1]) for (y in 1:length(w[1,])) { for (x in 2:length(w[,1])) { - cols = c(cols, palette[w[x,y]+range(w)[1]]) + cols = c(cols, palette[w[x,y]-range(w)[1]]) } } jpeg(paste0(world, "_iso.jpg"), width=720, height=720) -persp(1:100, 1:100, as.matrix(w), axes=F, theta=110, phi=50, - expand=0.4, col=cols, box=F, shade=0.3) +persp(1:(length(w[,1])), 1:(length(w[1,])), as.matrix(w), axes=F, + theta=110, phi=50, expand=0.4, col=cols, box=F, shade=0.3) dev.off()