;;;;
;;;; Naledi ya Africa ("Star of Africa") is a rogue-like survival game
;;;; set in Africa.
;;;;
;;;; This file defines patches and administrates the world object.
;;;;
;;;; (c) 2018 Daniel Vedder, MIT license
;;;;

(defparameter *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 &optional (pythag NIL))
	"Find the distance between two sets of coordinates"
	(if pythag (round (sqrt (+ (expt (- x1 x2) 2) (expt (- y1 y2) 2))))
		(min (abs (- x1 x2)) (abs (- y1 y2)))))

(defun closest-coords (here coord-list &optional (abs-dist NIL))
	"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) abs-dist))
				 (when c (distance (first here) (second here)
							 (first c) (second c) abs-dist)))
			 (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 orth-dir (dir &optional (cw T))
	"Get the direction orthogonal (at right angles) to the given one."
	(next-dir (next-dir dir cw) cw))

(defun diagonalp (dir)
	"Is dir a diagonal direction?"
	(member dir '(NE SE SW NW) :test #'eq))

(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 print-topography (&optional (stream T) (world *world*))
	"Print a text representation of the world and each patch's biome"
	(dolist (row world)
		(format stream "~&~A~%"
			(string-from-list
				(mapcar #'(lambda (p) (biome-char (patch-biome p))) row)
				""))))

(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)
		(print-topography tf)))

(defun get-patch-feature (patch)
	"Find a random feature (or none) to occupy this patch."
	(let ((flist (biome-features (patch-biome patch))))
		(dolist (f flist NIL)
			(when (chancep (second f))
				(return-from get-patch-feature (get-item-type (first f)))))))

(defun generate-biomes (size-factor world)
	;;XXX The maps this produces don't look quite 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 ((p (coord x y world))
						 (b (third (closest-coords (list x y) seeds T))))
					(setf (patch-biome p) (get-biome b))
					(setf (patch-occupant p) (get-patch-feature p)))))))
	
(defun generate-stream (x0 y0 world)
	(debugging "~&Generating a stream, starting at ~S/~S" x0 y0) ;debug
	(do* ((dir (random-elt *directions*)
			  (if (probabilityp 75) 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))
		(setf (patch-occupant patch) NIL)))

;;TODO create animal herds

(defun create-world (size)
	(let ((world (init-matrix size)))
		;;XXX magic numbers
		(generate-biomes 10 world)
		(dotimes (s (round (/ (expt size 2) 2000)))
			(generate-stream (random size) (random size) world))
		world))