;;;; ;;;; 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-descriptive-panel playerwin "describe-player") (draw-descriptive-panel placewin "describe-patch") (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-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 ;;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? )