;;;;
;;;; Terra Nostra is a Minecraft-like survival game for the commandline.
;;;;
;;;; This file defines patches and administrates the world object.
;;;;
;;;; (c) 2018 Daniel Vedder, MIT license
;;;;

(defvar *world* NIL)
(defconstant *directions* '(N NE E SE S SW W NW))

(defstruct patch
	(pos '(0 0)) ;position
	(biome NIL)
	(items '())
	(occupant NIL))

;; MATRIX FUNCTIONS

(defun init-matrix (size)
	"Create a square matrix of empty patches"
	;;TODO change this to arrays for performance
	(debugging "~&Creating a ~S/~S 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 distance (x1 y1 x2 y2)
	"Find the distance between two sets of coordinates"
	;;Ignores Pythagoras
	(min (abs (- x1 x2)) (abs (- y1 y2))))

(defun closest-coords (here coord-list)
	"Find the closest position to 'here' from a list of coordinates"
	(do* ((clist coord-list (cdr clist)) (c (car clist) (car clist))
			 (dist (when c (distance (first here) (second here)
							   (first c) (second c)))
				 (when c (distance (first here) (second here)
							 (first c) (second c))))
			 (mindist dist) (closest c))
		((null clist) closest)
		(when (< dist mindist)
			(setf mindist dist closest c))))

(defun opposite-dir (dir)
	"Return the direction opposite the input"
	(let ((pos (position dir *directions*)))
		(when pos (nth (rem (+ 4 pos) 8) *directions*))))

(defun next-dir (dir &optional (cw T))
	"Get the neighbouring direction (clockwise or anticlockwise)"
	(let ((pos (position dir *directions*))
			 (diff (if cw 1 -1)))
		(when pos (nth (rem (+ diff pos 8) 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))


;; TOPOGRAPHY FUNCTIONS

(defun save-topography (file-name &optional (world *world*))
	"Save the world topography as a text file"
	(debugging "~&Saving world to file ~A" file-name) ;debug
	(with-open-file (tf file-name :direction :output)
		(dolist (row world)
			(format (if file-name tf T) "~&~A~%"
				(string-from-list
					(mapcar #'(lambda (p) (biome-char (patch-biome p))) row)
					" ")))))
	
(defun generate-biomes (size-factor &optional (world *world*))
	;;XXX The maps this produces don't look as expected, but for
	;; current purposes they are good enough
	(debugging "~&Generating biomes") ;debug
	(let* ((world-size (length world)) (seeds NIL)
			  (nseeds (round (/ world-size size-factor)))
			  (biomes (remove-first-if
						  #'(lambda (e) (eq e 'stream))
						  (available-biomes))))
		;;Initialize a set of biome 'seed' coordinates
		(dotimes (n nseeds)
			(setf seeds
				(cons (list (random world-size)
						  (random world-size)
						  (random-elt biomes))
					seeds)))
		(debugging "~&~S" seeds)
		;;For each patch, calculate the closest seed and set to that biome
		(dotimes (x world-size)
			(dotimes (y world-size)
				(let ((b (third (closest-coords (list x y) seeds))))
					(setf (patch-biome (coord x y world))
						(get-biome b)))))))
	
(defun generate-stream (x0 y0 &optional (world *world*))
	(debugging "~&Generating a stream, starting at ~S/~S" x0 y0) ;debug
	(do* ((dir (random-elt *directions*)
			  (if (chancep 60) dir (next-dir dir (random-elt '(T NIL)))))
			 (patch (coord x0 y0 world) (neighbour patch dir world)))
		((or (null patch) (eq (patch-biome patch) (get-biome 'stream))))
		(setf (patch-biome patch) (get-biome 'stream))))

(defun create-world (size &optional (world *world*))
	(setf world NIL)
	(setf world (init-matrix size))
	;;XXX magic numbers
	(generate-biomes 20 world)
	(dotimes (s (round (/ (expt size 2) 500)))
		(generate-stream (random size) (random size) world)))