;;;;
;;;; 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"
;;TODO choose world size
(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
;;TODO (choose-world-size)
(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)
;;TODO ask for username/password!
(connect-server)
(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-old (win me)
"Draw a portion of the game map in an ncurses window"
(setf (croatoan:.color-pair win) '(:white :black))
(croatoan:box win)
(croatoan:move win 1 1)
(let ((x0 (- (first me) (round (/ (croatoan:.width win) 4))))
(y0 (- (second me) (halve (croatoan:.height win)))))
;; NB. x0 and w are calculated differently to y0 and h because we insert
;; a space after each character
(dotimes (h (1- (croatoan:.height win)))
(dotimes (w (- (halve (croatoan:.width win) 'floor) 2))
;;TODO replace `coord' with `query-server'
(let ((p (coord (+ w x0 3) (+ h y0 1))))
(if (null p) (croatoan:add-char win #\space)
(if (and (= (first (patch-pos p)) (first me))
(= (second (patch-pos p)) (second me)))
(progn (setf (croatoan:.color-pair win)
'(:white :black))
(croatoan:add-char win #\@))
(if (patch-occupant p)
(progn
(setf (croatoan:.color-pair win)
(list (.color (patch-occupant p))
:black))
(croatoan:add-char win
(.char (patch-occupant p))))
(progn
(setf (croatoan:.color-pair win)
(list (biome-col (patch-biome p))
:black))
(croatoan:add-char win
(biome-char (patch-biome p)))))))
(croatoan:add-char win #\space)))
(croatoan:move win (1+ h) 1))
(croatoan:refresh win)))
(defun draw-map (win)
"Draw a portion of the game map in an ncurses window"
;;FIXME 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)))
;;FIXME needs to be overhauled for client/server
(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."
(croatoan:clear win)
(croatoan:move win 0 0)
;;TODO get news from server
(croatoan:add-string win (car news))
(croatoan:refresh win))
(defun notify (news-string &rest formats)
"Append a string to the news to notify the user."
;;TODO needs to be moved to the server
;;A bit of a kluge, but means that `notify' supports formatting
(setf news
(cons (apply #'format (cons NIL (cons news-string formats)))
news)))
(defun message-window ()
"Return a dialog window with the last game messages."
;;TODO complete
;;TODO get news from server
;;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?
)
