;;;;
;;;; Naledi ya Africa ("Star of Africa") is an ncurses-based survival game
;;;; set in Africa.
;;;;
;;;; This is the main program file with the user interface.
;;;;
;;;; (c) 2018 Daniel Vedder, MIT license
;;;;
;;XXX move this file to src/ncurses.lisp?
(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))
(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 ((equalp (croatoan:current-item mw) "Start a local game")
;;TODO choose world size
(start-server)
(setf *host* (first *defaulthost*)
*port* (second *defaulthost*))
;;TODO check whether server is up!
(sleep 1) ;;give the server time to start
(connect-server))
((equalp (croatoan:current-item mw)
"Connect to a remote server")
(setf *host* (query-user scr "Server IP/URL:" T))
(setf *port* (read-from-string
(query-user scr "Server port:" T)))
(if (user-confirm-p scr
(format nil "Connect to ~A:~S?" *host* *port*)
T)
(connect-server)
(start-or-connect-to-server scr)))
(return-from croatoan:event-case))))))
;;TODO (choose-world-size)
(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)))
(me (list (round (/ width 4)) (halve height))))
(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 me)
;;TODO
(croatoan:event-case (scr event)
(#\q (disconnect)
(terminate)
(return-from croatoan:event-case)) ;XXX
(#\n (croatoan:draw-menu (message-window)))
(:up (decf (second me)) (update-ui mapwin playerwin
placewin newswin me))
(:down (incf (second me)) (update-ui mapwin playerwin
placewin newswin me))
(:left (decf (first me)) (update-ui mapwin playerwin
placewin newswin me))
(:right (incf (first me)) (update-ui mapwin playerwin
placewin newswin me))
((nil) (update-ui mapwin playerwin placewin newswin me))
(otherwise (notify (string event)))))))
(defun update-ui (mapwin playerwin placewin newswin me)
"Update all four UI elements"
(draw-map mapwin me)
(draw-player-panel playerwin)
(draw-place-panel placewin me)
(draw-news-panel newswin))
(defun draw-map (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))
(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-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 me)
"Draw a panel with information about the player's current location."
(let ((descr (break-lines (describe-patch me)
(- (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."
(croatoan:clear win)
(croatoan:move win 0 0)
(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."
;;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
(make-instance 'croatoan:dialog-window
:input-blocking t
:items (break-lines
(mapcar #'(lambda (n) (string-from-list (list "*" 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)))))
(defun query-user (scr msg &optional (cls NIL) (val-width 30))
"Display a popup asking the user to enter a value, then return that value"
;;XXX I found `field/form' to complicated to use (:form-default-keymap
;; doesn't seem to work), so I hacked up my own alternative
(when cls (croatoan:clear scr))
(croatoan:refresh scr)
(let* ((x0 (- (halve (croatoan:.width scr)) (+ 5 (halve val-width))))
(y0 (- (halve (croatoan:.height scr)) 3))
(inputwin (make-instance 'croatoan:window :position (list y0 x0)
:width (+ 10 val-width) :height 6)))
(setf (croatoan:.visible inputwin) t)
(croatoan:box inputwin)
(croatoan:add-string inputwin msg :y 2 :x 4)
(croatoan:add-string inputwin ">>> " :y 3 :x 4)
(croatoan:move inputwin 3 8)
(croatoan:refresh inputwin)
(croatoan:event-case (scr event)
((nil) nil)
(:backspace
(when (< 8 (croatoan:.cursor-position-x inputwin))
(croatoan:move inputwin 0 -1 :relative t)
(croatoan:add-char inputwin #\space)
(croatoan:move inputwin 0 -1 :relative t)
(croatoan:refresh inputwin)))
(#\newline
(return-from croatoan:event-case
(trim-whitespace
(croatoan:extract-string inputwin
:y 3 :x 8 :n val-width))))
(otherwise
(when (and (characterp event)
(> (+ 8 val-width)
(croatoan:.cursor-position-x inputwin)))
(croatoan:add-char inputwin event
:color-pair '(:blue :black))
(croatoan:refresh inputwin))))))
(defun user-confirm-p (scr msg &optional (cls NIL))
"Ask the user to confirm (Yes/No) a message."
(when cls (croatoan:clear scr))
(croatoan:refresh scr)
(let ((dw (make-instance 'croatoan:dialog-window
:center t :border t :width (max 20 (+ 4 (length msg)))
:max-item-length (max 4 (halve (length msg)))
:input-blocking t :layout '(1 2)
:message-height 1 :message-text msg
:items '(" Yes" " No"))))
(croatoan:draw-menu dw)
(croatoan:event-case (scr event)
((nil) nil)
((:left :right)
(croatoan:update-menu dw event)
(croatoan:draw-menu dw))
(#\newline
(return-from croatoan:event-case
(equalp (croatoan:current-item dw) " Yes"))))))
(defun process-command (event)
;;TODO
)
