;#!/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" (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) 'SE) ((< herey therey) 'NE) (T 'E))) ((< herex therex) (cond ((> herey therey) 'SW) ((< herey therey) 'NW) (T 'W))) (T (cond ((> herey therey) 'S) ((< herey therey) 'N) (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 "~&~S~%" 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 their number and height." (do ((n 0 (1+ n)) (npeaks (random (* (/ montaneity 100) (* (length world) (length (first world))))))) ((= n npeaks) world) (setf world (create-peak (random (first world)) (random (length world)) (random (* montaneity 100)) world)))) (defun create-peak (x y height world) "Create a mountain peak at the specified location" ;;TODO ) (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 (first world))))))) ((= n nstreams) world) (create-stream (random (first world)) (random (length world)) 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) (zerop (random 2))))) (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)))))) (format t "~&Creating a stream at ~S/~S, flowing ~S." x y dir) ;; 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))) ;; Initialize the random state (which would otherwise not be very random...) (setf *random-state* (make-random-state t))