;;;;
;;;; 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))
;;FIXME 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 localuser default")) ;;just use a default user
(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 "* "
: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 (halve height 'down))
(placewin :input-blocking *framerate*
:border t
:position (list (halve height)
(- width 50))
:width 50 :height (halve height 'down))
(newswin :input-blocking *framerate*
:position (list height 0)
:width width :height 1))
(update-ui mapwin playerwin placewin newswin)
;;TODO
(croatoan:event-case (scr event)
(#\q (disconnect)
;;terminate if we're running a local game
(when (member "server-thread" (bt:all-threads) :test
#'(lambda (nm th)
(equalp nm (bt:thread-name th))))
(terminate))
(return-from croatoan:event-case))
(#\n (croatoan:draw-menu (message-window)))
;;XXX How about moving diagonally?
(:up (query-server "move n")
(update-ui mapwin playerwin placewin newswin))
(:down (query-server "move s")
(update-ui mapwin playerwin placewin newswin))
(:left (query-server "move w")
(update-ui mapwin playerwin placewin newswin))
(:right (query-server "move e")
(update-ui mapwin playerwin placewin newswin))
((nil) (update-ui mapwin playerwin placewin newswin))
(otherwise (notify (string event)))))))
(defun update-ui (mapwin playerwin placewin newswin)
"Update all four UI elements"
(draw-map mapwin)
(draw-player-panel playerwin)
(draw-place-panel placewin)
(draw-news-panel 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-player-panel (win)
"Draw a panel with information about the player character."
;;TODO
(croatoan:box win)
(croatoan:move win 1 1)
(croatoan:add-string win "This is the player panel.")
(croatoan:refresh win))
(defun draw-place-panel (win)
"Draw a panel with information about the player's current location."
(let ((descr (break-lines (query-server "describe-patch")
(- (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.")))
(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)
(croatoan:add-string win (car news))
(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)))))
(defun message-window ()
"Return a dialog window with the last game messages."
;;TODO complete - stop the window disappearing
;;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) 50)
: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?
)
