;;;;
;;;; 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))
;;FIXME breaks on multi-word names
(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)
(flet ((ui-update ()
(de.anvi.ncurses:%flushinp) ;discard excessive key events
(update-ui mapwin playerwin placewin newswin)))
(croatoan:event-case (scr event)
;; quit on Q wherever we are
(#\q (if (user-confirm-p scr "Really quit?")
(progn (disconnect)
(return-from croatoan:event-case))
(ui-update)))
((nil) (ui-update)) ;just update the screen when idle
(otherwise
(interpret-command scr event)
(ui-update)))))))
(defun interpret-command (scr event)
"Interpret a key command entered by the user"
(handler-case
(case event
;; ;;XXX How about moving diagonally?
(:up (query-server "move n"))
(:down (query-server "move s"))
(:left (query-server "move w"))
(:right (query-server "move e"))
;;TODO add other commands
(#\n (set-popup 'NEWS))
;;(#\h -> help window
;;(#\a -> toggle attack mode
;;(#\c -> command console
;;(#\p -> pickup item
;;(#\i -> manage inventory
)
;;XXX this silences the error?
;;XXX actually, does it even do anything?
(error () (disconnect))))
;;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"
(draw-news-panel newswin)
(when (and (not popup) (connectedp))
(draw-map mapwin)
(draw-descriptive-panel playerwin "describe-player")
(draw-descriptive-panel placewin "describe-patch")))
(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."
(when (connectedp) (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)
;;TODO add a display-time argument
"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?
)
