Newer
Older
naledi / client / user-interface.lisp
;;;;
;;;; Naledi ya Africa ("Star of Africa") is an ncurses-based survival game
;;;; set in Africa.
;;;;
;;;; This file holds the user interface.
;;;;
;;;; (c) 2018 Daniel Vedder, MIT license
;;;;

(in-package :naledi-ya-africa)
;;(use-package :croatoan)


(defun start-game ()
	"Start the game logic and UI"
	(croatoan:with-screen (scr :input-blocking *framerate* :enable-colors t
							  :input-echoing nil :cursor-visibility nil
							  :input-reading :unbuffered)
		(splash-screen scr)
		(start-or-connect-to-server scr)
		(user-interface scr)))

(defun splash-screen (scr)
	"Display the splash screen with the `Naledi ya Africa' logo"
	(let* ((width (croatoan:.width scr)) (height (croatoan:.height scr))
			  ;;XXX fails when not in the naledi directory
			  (logo (load-text-file "LOGO"))
			  (y (halve (- height (length logo))))
			  (xoff (halve (- width 80))))
		(croatoan:clear scr)
		(dolist (l logo)
			(croatoan:move scr y xoff)
			(croatoan:add-string scr l)
			(incf y))
		(croatoan:move scr (1- height) 0)
		(croatoan:add-string scr "Press any key to continue.")
		(croatoan:move scr (1- height) (- width 22))
		(croatoan:add-string scr "(c) 2018 Daniel Vedder")
		(croatoan:event-case (scr event)
			((nil) nil)
			(otherwise (return-from croatoan:event-case)))))

(defun start-or-connect-to-server (scr)
	"Choose whether to start a local game or connect to a remote server"
	(croatoan:clear scr)
	(croatoan:refresh scr)
	(let ((mw (make-instance 'croatoan:dialog-window
				  :title "Welcome!"
				  :center t :border t :width 50
				  :max-item-length 42 :input-blocking t
				  :cyclic-selection t :current-item-mark "* "
				  :items '("Start a local game"
							  ;;TODO "Load a saved game"
							  "Connect to a remote server"))))
		;;XXX I have to effectively reimplement (select-item menu) because
		;; the screen grabs all user input and none arrives at the window
		(croatoan:draw-menu mw)
		(croatoan:event-case (scr event)
			((nil) nil)
			((:up :down)
				(croatoan:update-menu mw event)
				(croatoan:draw-menu mw))
			(#\newline
				(cond ((= (croatoan:.current-item-number mw) 0)
						  (start-local-game scr))
					((= (croatoan:.current-item-number mw) 1)
						(connect-remote-game scr)))
				(return-from croatoan:event-case)))))

(defun start-local-game (scr)
	"Start a local game"
	(choose-world-size scr)
	(start-server)
	(setf *host* (first *defaulthost*)
		*port* (second *defaulthost*))
	;;give the server time to start
	(while (not (runningp)) ;;TODO replace with `loop'
		(sleep 0.5))
	(connect-server)
	(query-server "signup"
		(query-user scr "What is your name?" :cls T)
		"default"))

(defun choose-world-size (scr)
	"Let the user choose his preferred world size"
	(croatoan:clear scr)
	(croatoan:refresh scr)
	(let ((mw (make-instance 'croatoan:dialog-window
				  :title "Please choose a world size"
				  :center t :border t :width 50
				  :max-item-length 42 :input-blocking t
				  :cyclic-selection t :current-item-mark "* "
				  ;;TODO change to 250, 500, 1000, 5000
				  :items '("Small (100)" "Standard (250)" "Medium (500)"
							  "Large (1000)")))) ;"Huge (5000)"))))
		;;XXX I have to effectively reimplement (select-item menu) because
		;; the screen grabs all user input and none arrives at the window
		(setf (croatoan:.current-item-number mw) 1)
		(croatoan:draw-menu mw)
		(croatoan:event-case (scr event)
			((nil) nil)
			((:up :down)
				(croatoan:update-menu mw event)
				(croatoan:draw-menu mw))
			(#\newline
				(case (croatoan:.current-item-number mw)
					(0 (setf *world-size* 100))
					(1 (setf *world-size* 250))
					(2 (setf *world-size* 500))
					(3 (setf *world-size* 1000)))
					;;XXX uses >1GB RAM -> heap exhaustion
					;;(4 (setf *world-size* 5000)))
				(return-from croatoan:event-case)))))

(defun connect-remote-game (scr)
	"Ask the user which server to connect to and do so"
	(setf *host* (query-user scr "Server IP/URL:" :cls T))
	(setf *port* (read-from-string
					 (query-user scr "Server port:"
						 :default (second *defaulthost*) :cls T)))
	(if (user-confirm-p scr (format nil "Connect to ~A:~S?" *host* *port*) T)
		(progn (connect-server)
			(login-or-signup scr))
		(start-or-connect-to-server scr)))

(defun login-or-signup (scr)
	"Ask for username/password and log the user in"
	(let* ((uname (query-user scr "User name:" :cls T))
			  (upass (query-user scr "Password:" :cls T))
			  (reply (query-server "login" uname upass ':ignore-errors)))
		(cond ((search "bad password" reply)
				  (inform-user scr "Bad password!" T)
				  (start-or-connect-to-server scr))
			((search "nonexistent player" reply)
				(if (user-confirm-p scr "This player doesn't exist. Create?" T)
					(query-server "signup" uname upass)
					(start-or-connect-to-server scr))))))

(defun user-interface (scr)
	"Create the screen on the ncurses interface and hand over to window functions"
	(let ((width (croatoan:.width scr)) (height (1- (croatoan:.height scr))))
		(croatoan:clear scr)
		(croatoan:refresh scr)
		(croatoan:with-windows ((mapwin :position '(0 0)
									:input-blocking *framerate*
									:border t :width (- width 51)
									:height height)
								   (playerwin :position (list 0 (- width 50))
									   :input-blocking *framerate* :border t
									   :width 50 :height (round (* 0.6 height)))
								   (placewin :input-blocking *framerate*
									   :border t
									   :position (list (round (* 0.6 height))
													 (- width 50))
									   :width 50 :height (round (* height 0.4)))
								   (newswin :input-blocking *framerate*
									   :position (list height 0)
									   :width width :height 1))
			(update-ui mapwin playerwin placewin newswin)
			;;XXX This function is too long - shift the `event-case' elsewhere?
			(flet ((ui-update ()
					   (de.anvi.ncurses:%flushinp) ;discard excessive key events
					   (update-ui mapwin playerwin placewin newswin)))
				(croatoan:event-case (scr event)
					;;TODO add other commands
					;;(#\h -> help window
					;;(#\a -> toggle attack mode
					;;(#\c -> command console
					;;(#\p -> pickup item
					;;(#\i -> manage inventory
					(#\q (disconnect)
						;;terminate if we're running a local game
						(when (runningp) (terminate))
						(return-from croatoan:event-case))
					(#\n (set-popup 'NEWS) (ui-update))
					;;XXX How about moving diagonally?
					(:up (query-server "move n") (ui-update))
					(:down (query-server "move s") (ui-update))
					(:left (query-server "move w") (ui-update))
					(:right (query-server "move e") (ui-update))
					((nil) (ui-update)))))))

;;TODO This is not yet a good solution. First, window objects are
;; constantly created. Secondly, these windows cannot be controlled,
;; because all key events are still handled by the main UI...

;;TODO I'm going to have to do this with the window stack
;; -> set .stacked T in all windows, use `refresh-stack'
;; (see croatoan CLOS tests line 980)

(let ((popup nil) (popup-modes '(NEWS CONSOLE INVENTORY)))
	(defun set-popup (&optional next-popup)
		"Which popup window should be shown?"
		(if (or (null next-popup) (member next-popup popup-modes))
			(setf popup next-popup)
			(error "~S is not a permitted popup mode." next-popup)))

	(defun update-ui (mapwin playerwin placewin newswin)
		"Update all active UI elements"
		(unless popup
			(draw-map mapwin)
			(draw-descriptive-panel playerwin "describe-player")
			(draw-descriptive-panel placewin "describe-patch")
			(draw-news-panel newswin)))

	(defun draw-popup-window ()
		"Draw the current popup window, if appropriate"
		(case popup
			('NEWS (croatoan:draw-menu (message-window)))
			('CONSOLE )
			('NEWSWIN ))))

(defun draw-map (win)
	"Draw a portion of the game map in an ncurses window"
	;;XXX request each patch char singly from the server - doing it all
	;; in one batch seems to take too many resources?
	(setf (croatoan:.color-pair win) '(:white :black))
	(croatoan:box win)
	(croatoan:move win 1 1)
	(let* ((map-width (- (halve (croatoan:.width win) 'floor) 2))
			  (map-height (1- (croatoan:.height win)))
			  ;; It's a bit ugly that I have to do a `read-from-string` here,
			  ;; but see the server-side function `get-map' for details
			  (submap (read-from-string
						  (query-server "map" map-width map-height))))
		(dotimes (h map-height)
			(dotimes (w map-width)
				(let ((pch (aref submap w h 0)) (pcol (aref submap w h 1)))
					(croatoan:add-char win pch :color-pair (list pcol :black))
					(croatoan:add-char win #\space)))
			(croatoan:move win (1+ h) 1)))
	(croatoan:refresh win))

(defun draw-descriptive-panel (win query)
	"Draw a panel with information about the player or his location."
	(let ((descr (break-lines (query-server query)
					 (- (croatoan:.width win) 2))))
		(croatoan:clear win)
		(croatoan:box win)
		(croatoan:move win 1 1)
		(dolist (d descr)
			(croatoan:add-string win d)
			(croatoan:move win
				(1+ (first (croatoan:.cursor-position win))) 1))
		(croatoan:refresh win)))

(let ((news '("Press h for help.")) (display-time 6) (timer 0))
	(defun draw-news-panel (win)
		"Draw a thin panel at the bottom of the screen to display news items."
		(collect-news)
		(croatoan:clear win)
		(croatoan:move win 0 0)
		(when (< timer display-time)
			(croatoan:add-string win (car news))
			(incf timer))
		(croatoan:refresh win))

	(defun collect-news ()
		"Collect news for this player from the server"
		;;XXX I don't quite understand why I need to do `read-from-string' here
		(let ((messages (read-from-string (query-server "messages"))))
			(when messages
				(setf news (append messages news))
				(setf timer 0))))

	(defun notify (msg &rest format-args)
		"Pass a message from the client to the user"
		(let ((m (apply #'format (append (list NIL msg) format-args))))
			(setf news (append (list m) news))
			(setf timer 0)))
	
	(defun message-window ()
		"Return a dialog window with the last game messages."
		;;TODO complete - stop the window disappearing (caused by main
		;; window being drawn over this one)
		;;XXX use `user-inform' instead of dialog-window?
		(make-instance 'croatoan:dialog-window
			:input-blocking t
			:items (break-lines (mapcar #'(lambda (n) (sconc "* " n)) news) 49)
			:center t
			:border t
			:stacked t
			:layout nil
			:title "Game messages"
			:max-item-length 50
			:message-height 2
			:message-text "Press b to go back.")))
			;;:event-handlers '((#\b #'exit-event-loop)))))

;;TODO command/chat window

(defun process-command (event)
	;;TODO
	;;XXX move to another file?
	)