;#!/usr/bin/clisp
;;;;
;;;; 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
;;;;

(load "util.lisp")
(load "items.lisp")
(load "biome.lisp")
(load "animals.lisp")

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

(defstruct patch
	(pos '(0 0)) ;position
	(biome (get-biome 'grassland))
	(items '())
	(occupant 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 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))

(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)
			;; TODO This would be quicker with (string-from-list)
			(do ((x 0 (1+ x)) (xstr ""))
				((= x (length world)) (format tf "~&~A~%" xstr))
				(setf xstr (concatenate 'string xstr (unless (= x 0) ",")
							   (format NIL "~S"
								   (biome-char (patch-biome (nth x row))))))))))


(defun generate-biome-patch (biome-type x y width &optional (world *world*))
	;;TODO
	)

(defun generate-stream (x0 y0 &optional (world *world*))
	(do* ((dir (random-elt *directions*)
			  (if (chancep 60) 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))))

(defun create-world (size name &optional (world *world*)
						(biomes '(forest hill)) (size-factor 30))
	(setf world NIL)
	(setf world (init-matrix size))
	;;XXX magic numbers
	(dotimes (s (round (/ (expt size 2) (* size-factor 10))))
		(generate-stream (random size) (random size) world))
	(dotimes (f (round (/ (expt size 2) (expt size-factor 2))))
		(generate-biome-patch 'forest (random size) (random size)
			(random size-factor) world))
	(dotimes (h (round (/ (expt size 2) (* 1.5 (expt size-factor 2)))))
		(generate-biome-patch 'hill (random size) (random size)
			(random (round (/ 2 size-factor))) world))
	;;TODO
	(save-topography name world))

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