;#!/usr/bin/clisp ;;;; ;;;; Terra Nostra is a Minecraft-like survival game for the commandline. ;;;; ;;;; (c) 2018 Daniel Vedder ;;;; ;;(load "util.lisp") ;; I want to avoid using this if possible (defvar *world* NIL) (defconstant *directions* '(N NE E SE S SW W NW)) (defconstant *base-height* 50) (defstruct patch (pos '(0 0)) ;position (alt *base-height*) ;altitude (stream-in NIL) (stream-out NIL)) (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) (setf row (append row (list (make-patch :pos (list x y)))))) (setf world (append world (list row))))) (defun coord (x y &optional (world *world*)) "Return the patch at the given coordinates or NIL if out of bounds" (unless (or (< x 0) (< y 0) (> x (length world)) (> y (length world))) (nth x (nth y world)))) (defun opposite-dir (dir) "Return the direction opposite the input" (let ((pos (position dir *directions*))) (when pos (nth (rem (+ 4 pos) 8) *directions*)))) (defun dir2patch (herex herey therex therey) "Calculate the direction to a patch" (cond ((> herex therex) (cond ((> herey therey) 'NW) ((< herey therey) 'SW) (T 'W))) ((< herex therex) (cond ((> herey therey) 'NE) ((< herey therey) 'SE) (T 'E))) (T (cond ((> herey therey) 'N) ((< herey therey) 'S) (T NIL))))) (defun coordsindir (x y dir) "Return the coordinates in the given direction" (cond ((eq dir 'N) (list x (1- y))) ((eq dir 'NE) (list (1+ x) (1- y))) ((eq dir 'E) (list (1+ x) y)) ((eq dir 'SE) (list (1+ x) (1+ y))) ((eq dir 'S) (list x (1+ y))) ((eq dir 'SW) (list (1- x) (1+ y))) ((eq dir 'W) (list (1- x) y)) ((eq dir 'NW) (list (1- x) (1- y))) ((null dir) (list x y)) (T (error "~&Invalid direction ~S")))) (defun patchindir (x y dir &optional (world *world*)) "Return the patch in the given direction" (let* ((coords (coordsindir x y dir)) (nextx (first coords)) (nexty (second coords))) (coord nextx nexty world))) (defun neighbour (p dir &optional (world *world*)) "Return the neighbouring patch in this direction" (patchindir (first (patch-pos p)) (second (patch-pos p)) dir world)) (defun save-topography (file-name &optional (world *world*)) "Save the world topography as a csv file" (with-open-file (tf file-name :direction :output) (dolist (row world) ;; XXX This would be quicker with (string-from-list), but I ;; don't want to use util.lisp just yet (do ((x 0 (1+ x)) (xstr "")) ((= x (length world)) (format tf "~&~A~%" xstr)) (setf xstr (concatenate 'string xstr (unless (= x 0) ",") (format NIL "~S" (patch-alt (nth x row))))))))) (defun create-mountains (world &optional (montaneity 2)) "Create mountains and hills. Montaneity determines number and height." ;;XXX Takes too long to calculate if world size > 100 (do ((n 0 (1+ n)) (npeaks (random (* (/ montaneity 500) (* (length world) (length world)))))) ((= n npeaks)) (create-peak (random (length world)) (random (length world)) (+ *base-height* (random (* montaneity 100))) montaneity world))) (defun create-peak (xcoord ycoord height montaneity world) "Create a mountain peak at the specified location" ;;TODO Can I make this more computationally efficient? (unless (< (patch-alt (coord xcoord ycoord world)) height) (return-from create-peak)) (format t "~&Creating a peak of ~Sm at ~S/~S" height xcoord ycoord) (setf (patch-alt (coord xcoord ycoord world)) height) ;; Process concentric squares in increasing distance from the peak (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)) ;; Get the current patch and its center-side neighbour (p (coord x y world) (coord x y world)) (np (when p (neighbour p (dir2patch x y xcoord ycoord) world)) (when p (neighbour p (dir2patch x y xcoord ycoord) world)))) ((> y (+ ycoord dist))) ;; Only calculate existing patches that haven't been done yet (when (and p (or (= (abs (- xcoord x)) dist) (= (abs (- ycoord y)) dist))) (let ((new-alt (- (patch-alt np) (random (* montaneity 5))))) ;; Eventually, a hill levels out (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)) (size (length world)) (x (random size) (random size)) (y (random size) (random size)) (nstreams (random (* (/ aqueousness 500) (* size size))))) ((= n nstreams)) (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" (let* ((minheight (* *base-height* 1000)) (here (coord x y world)) ;;XXX hack: minheight must initially be higher than any patch (nextpatch NIL) (dir NIL)) ;;Figure out the lowest neighbouring patch (dolist (d *directions*) (let* ((np (patchindir x y d)) (alt (when np (patch-alt np)))) (when (and np (not (eq d (patch-stream-in here))) (or (< alt minheight) (and (= alt minheight) (> 2 (random 10))))) (setf minheight alt) (setf dir d nextpatch np)))) ;;Erode this patch (let* ((instream (patch-stream-in here)) (maxheight (if instream (patch-alt (neighbour here instream)) (patch-alt here)))) (setf (patch-alt here) (- maxheight (random (round (/ maxheight 10)))))) ;; Test for break conditions (hitting another stream or the edge ;; of the world) (unless (and dir nextpatch (null (patch-stream-out nextpatch))) (return-from create-stream)) ;;Set streams-in and streams-out (setf (patch-stream-out (coord x y)) dir) (setf (patch-stream-in nextpatch) (opposite-dir dir)) ;;Continue forming the stream (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))