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

(in-package :naledi-ya-africa)

;;; PATCHES AND BIOMES

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

(defstruct biome
	(name "")
	(ground "")
	(landscape T) ;part of the landscape?
	(features '()) ;an alist of possible features and their 1/p probabilities
	(char #\.) ;default map display character
	(col ':white)) ;default map display colour

(let ((biome-list NIL))
	(defun register-biome (symbol-name biome-object)
		(setf biome-list (cons (list symbol-name biome-object) biome-list)))

	(defun available-biomes ()
		(keys biome-list))

	(defun get-biome (symbol-name)
		(cassoc symbol-name biome-list)))

(defmacro new-biome (name &body body)
	`(register-biome ',name
		 (make-biome
			 :name ,(symbol-to-string name)
			 ,@body)))

;;; MATRIX FUNCTIONS

(defun init-matrix (size)
	"Create a square matrix of empty patches"
	(logf 4 "~&Creating a ~S/~S matrix." size size)
	(let ((world (make-array (list size size)
					 :element-type 'patch)))
		(dotimes (y size world)
			(dotimes (x size)
				(setf (aref world y x)
					(make-patch :pos (list x y)))))))

(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)
	"Return the patch in the given direction"
	(let* ((coords (coordsindir x y dir))
			  (nextx (first coords)) (nexty (second coords)))
		(coord nextx nexty)))

(defun neighbour (p dir)
	"Return the neighbouring patch in this direction"
	(patchindir (first (patch-pos p)) (second (patch-pos p)) dir))


;;; WORLD CREATION FUNCTIONS

(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
					(make-instance (first f) :x (first (patch-pos patch))
						:y (second (patch-pos patch))))))))

(defun generate-biomes (size-factor)
	;;XXX The maps this produces don't look quite as expected, but for
	;; current purposes they are good enough
	(let* ((wsize (world-size)) (seeds NIL)
			  (nseeds (round (/ wsize size-factor)))
			  (biomes (remove-if
						  #'(lambda (e) (null (biome-landscape (get-biome e))))
						  (available-biomes))))
		;;Initialize a set of biome 'seed' coordinates
		(dotimes (n nseeds)
			(setf seeds
				(cons (list (random wsize)
						  (random wsize)
						  (random-elt biomes))
					seeds)))
		(logf 5 "~&~S" seeds)
		;;For each patch, calculate the closest seed and set to that biome
		(dotimes (x wsize seeds)
			(dotimes (y wsize)
				(let ((p (coord x y))
						 (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)
	(logf 5 "~&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) (neighbour patch dir)))
		((or (null patch) (eq (patch-biome patch) (get-biome 'stream))))
		(setf (patch-biome patch) (get-biome 'stream))
		(setf (patch-occupant patch) NIL)))

(defun create-world (size)
	"Create a world of the specified size (square)"
	(set-world (init-matrix size))
	;;TODO remove magic numbers
	(logf 3 "~&Generating biomes")
	(generate-biomes 10)
	(logf 3 "~&Generating streams")
	(dotimes (s (round (/ (expt size 2) 2000)))
		(generate-stream (random size) (random size))))

(defun init-world ()
	"Initialize the log, RNG, and world."
	(when (> *loglevel* 1) (write-to-file "NALEDI ya AFRICA" *logfile*))
	(logf 2 "~&~A~%Log level ~S" (time-stamp) *loglevel*)
	(setf *random-state* (make-random-state t))
	(create-world *world-size*))


;;; ADMINISTRATE THE WORLD OBJECT

(let ((world NIL))
	;;XXX do we need to keep track of the current world map (i.e. patch chars
	;; and colours),or player map requests will take way too long to serve?
	(defun set-world (w) (setf world w))

	(defun world-size () (first (array-dimensions world)))

	(defun save-topography (file-name) ;XXX (re)move this?
		"Save the world topography as a text file"
		(logf 3 "~&Saving world to file ~A" file-name) ;debug
		(with-open-file (tf file-name :direction :output)
			(dolist (row world)
				(format stream "~&~A~%"
					(string-from-list
						(mapcar #'(lambda (p)
									  (biome-char (patch-biome p)))
							row) "")))))

	(defun save-world (&optional (file-name "naledi.save"))
		;;TODO
		(save-players file-name))
	
	(defun coord (x y)
		"Return the patch at the given coordinates or NIL if out of bounds"
		(unless (or (< x 0) (< y 0)
					;;XXX not sure if first/second is right way round here...
					(>= x (first (array-dimensions world)))
					(>= y (second (array-dimensions world))))
			(aref world y x))))