;#!/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) '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."
	(do ((n 0 (1+ n)) (npeaks (random (* (/ montaneity 100)
										  (* (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"
	(format t "~&Creating a peak of ~Sm at ~S/~S" height xcoord ycoord)
	(setf (patch-alt (coord xcoord ycoord world)) height)
	(do ((dist 1 (1+ dist)) (levelp NIL))
		(levelp)
		(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)))))
				((> 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

(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))))))
		((= n nstreams))
		(create-stream (random (length 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) (> 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)))


;; Initialize the random state (which would otherwise not be very random...)
(setf *random-state* (make-random-state t))