;;;;
;;;; Naledi ya Africa ("Star of Africa") is a rogue-like survival game
;;;; set in Africa.
;;;;
;;;; This is the main program file with the user interface.
;;;;
;;;; (c) 2018 Daniel Vedder, MIT license
;;;;


(defvar *debugging* T)

(ql:quickload :croatoan)
(use-package :croatoan)

(load "util.lisp")
(load "classes.lisp")
(load "data.lisp")
(load "world.lisp")
(load "items.lisp")
(load "biomes.lisp")
(load "animals.lisp")

(defun start-game ()
	(with-screen (scr :input-echoing nil :input-blocking t :enable-colors t
					 :cursor-visibility nil :input-reading :unbuffered)
		(splash-screen scr)
		(user-interface scr)))

(defun splash-screen (scr)
	"Display the splash screen with the `Naledi ya Africa' logo"
	(let* ((width (.width scr)) (height (.height scr))
			  (logo (load-text-file "LOGO"))
			  (y (halve (- height (length logo))))
			  (xoff (halve (- width 80))))
		(clear scr)
		(dolist (l logo)
			(setf (.cursor-position scr) (list y xoff))
			(add-string scr l)
			(incf y))
		(setf (.cursor-position scr) (list (1- height) 0))
		(add-string scr "Press any key to continue.")
		(event-case (scr event)
			(otherwise (return-from event-case)))))

(defun user-interface (scr)
	"Create the screen on the ncurses interface and hand over to window functions"
	;(clear scr)
	(let* ((width (.width scr)) (height (1- (.height scr)))
			  (me (list (round (/ width 4)) (halve height))))
		(with-windows ((mapwin :position '(0 0) :input-blocking t :border t
						   :width (- width 51) :height height)
						  (playerwin :position (list 0 (- width 50))
							  :input-blocking t :border t
							  :width 50 :height (halve height 'down))
						  (placewin :input-blocking t :border t
							  :position (list (halve height) (- width 50))
							  :width 50 :height (halve height 'down))
						  (newswin :input-blocking t
							  :position (list height 0)
							  :width width :height 1))
			(update-ui mapwin playerwin placewin newswin me)
			;(refresh scr)
			;;TODO
			(event-case (scr event)
				(#\q (return-from event-case))
				(#\n (draw-menu (message-window)))
				(:up (decf (second me)) (update-ui mapwin playerwin
											placewin newswin me))
				(:down (incf (second me)) (update-ui mapwin playerwin
											  placewin newswin me))
				(:left (decf (first me)) (update-ui mapwin playerwin
											 placewin newswin me))
				(:right (incf (first me)) (update-ui mapwin playerwin
											  placewin newswin me))
				(otherwise (notify (string event)))))))

(defun update-ui (mapwin playerwin placewin newswin me)
	"Update all four UI elements"
	;;TODO implement missing functions
	(draw-map mapwin me)
	(draw-player-panel playerwin)
	(draw-place-panel placewin me)
	(draw-news-panel newswin))

(defun draw-map (win me)
	"Draw a portion of the game map in an ncurses window"
	;;FIXME do I have a transpose bug here?
	(setf (.color-pair win) '(:white :black))
	(box win)
	(setf (.cursor-position win) '(1 1))
	(let ((x0 (- (first me) (halve (.width win))))
			 (y0 (- (second me) (halve (.height win)))))
		(dotimes (h (1- (.height win)))
			(dotimes (w (- (halve (.width win) 'floor) 2))
				(let ((p (coord (+ w x0 1) (+ h y0 1))))
					(if (null p) (add-char win #\space)
						(if (and (= (first (patch-pos p)) (first me))
								(= (second (patch-pos p)) (second me)))
							;;FIXME `me' is not drawn
							(progn (setf (.color-pair win) '(:white :black))
								(add-char win #\X))
							(if (patch-occupant p)
								(progn
									(setf (.color-pair win)
										(list (.color (patch-occupant p))
											:black))
									(add-char win (.char (patch-occupant p))))
								(progn
									(setf (.color-pair win)
										(list (biome-col (patch-biome p))
											:black))
									(add-char win
										(biome-char (patch-biome p)))))))
					(add-char win #\space)))
			(setf (.cursor-position win) (list (1+ h) 1)))
		(refresh win)))

(defun draw-player-panel (win)
	"Draw a panel with information about the player character."
	;;TODO
	(box win)
	(setf (.cursor-position win) '(1 1))
	(add-string win "This is the player panel.")
	(refresh win))

(defun draw-place-panel (win me)
	"Draw a panel with information about the player's current location."
	(debugging "~&~S" me)
	(let* ((p (coord (first me) (second me))) (descr (describe-patch p)))
		(clear win)
		(box win)
		(setf (.cursor-position win) '(1 1))
		(dolist (d descr)
			(add-string win d)
			(setf (.cursor-position win)
				(list (1+ (first (.cursor-position win))) 1)))
		(refresh win)))

(let ((news '("Press h for help.")))
	(defun draw-news-panel (win)
		"Draw a thin panel at the bottom of the screen to display news items."
		;;TODO
		(clear win)
		(setf (.cursor-position win) '(0 0))
		(add-string win (car news))
		(refresh win))

	(defun notify (news-string)
		"Append a string to the news to notify the user."
		;;FIXME This needs to support (format)
		(setf news (cons news-string news)))

	(defun message-window ()
		"Return a dialog window with the last game messages."
		(make-instance 'dialog-window
			:input-blocking t
			:items (mapcar
					   #'(lambda (n) (string-from-list (list "*" n) " "))
					   news)
			:center t
			:border t
			:layout nil
			:title "Game messages"
			:max-item-length 50)))
			;:scrolled-layout '(10 1)
			;; :message-height 2
			;; :message-text "Press b to go back."
			;; :event-handlers '((#\b #'exit-event-loop)))))

(defun process-command (event)
	;;TODO
	)

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

(create-world 100)
(start-game)