;;;; ;;;; 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 ;;;; (defparameter *debugging* T) (defparameter *logfile* "naledi.log") (ql:quickload :bordeaux-threads) (ql:quickload :croatoan) (use-package :croatoan) (load "util.lisp") (load "item-classes.lisp") (load "item-methods.lisp") (load "data.lisp") (load "world.lisp") (load "items.lisp") (load "biomes.lisp") (load "animals.lisp") (defun start-game () (setf *random-state* (make-random-state t)) (create-world 250) (bt:make-thread #'update-loop :name "world-thread") (with-screen (scr :input-echoing nil :input-blocking t :enable-colors t :cursor-visibility nil :input-reading :unbuffered) (splash-screen scr) (user-interface scr))) (defun splash-screen (scr) "Display the splash screen with the `Naledi ya Africa' logo" (let* ((width (.width scr)) (height (.height scr)) (logo (load-text-file "LOGO")) (y (halve (- height (length logo)))) (xoff (halve (- width 80)))) (clear scr) (dolist (l logo) (move scr y xoff) (add-string scr l) (incf y)) (move scr (1- height) 0) (add-string scr "Press any key to continue.") (move scr (1- height) (- width 22)) (add-string scr "(c) 2018 Daniel Vedder") (event-case (scr event) (otherwise (return-from event-case))))) (defun user-interface (scr) "Create the screen on the ncurses interface and hand over to window functions" (let* ((width (.width scr)) (height (1- (.height scr))) (me (list (round (/ width 4)) (halve height)))) (clear scr) (refresh scr) (with-windows ((mapwin :position '(0 0) :input-blocking t :border t :width (- width 51) :height height) (playerwin :position (list 0 (- width 50)) :input-blocking t :border t :width 50 :height (halve height 'down)) (placewin :input-blocking t :border t :position (list (halve height) (- width 50)) :width 50 :height (halve height 'down)) (newswin :input-blocking t :position (list height 0) :width width :height 1)) (update-ui mapwin playerwin placewin newswin me) ;;TODO (event-case (scr event) (#\q (return-from event-case)) (#\n (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)) (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 (.color-pair win) '(:white :black)) (box win) (move win 1 1) (let ((x0 (- (first me) (round (/ (.width win) 4)))) (y0 (- (second me) (halve (.height win))))) ;; NB. x0 and w are calculated differently to y0 and h because we insert ;; a space after each character (dotimes (h (1- (.height win))) (dotimes (w (- (halve (.width win) 'floor) 2)) (let ((p (coord (+ w x0 3) (+ h y0 1)))) (if (null p) (add-char win #\space) (if (and (= (first (patch-pos p)) (first me)) (= (second (patch-pos p)) (second me))) (progn (setf (.color-pair win) '(:white :black)) (add-char win #\@)) (if (patch-occupant p) (progn (setf (.color-pair win) (list (.color (patch-occupant p)) :black)) (add-char win (.char (patch-occupant p)))) (progn (setf (.color-pair win) (list (biome-col (patch-biome p)) :black)) (add-char win (biome-char (patch-biome p))))))) (add-char win #\space))) (move win (1+ h) 1)) (refresh win))) (defun draw-player-panel (win) "Draw a panel with information about the player character." ;;TODO (box win) (move win 1 1) (add-string win "This is the player panel.") (refresh win)) (defun draw-place-panel (win me) "Draw a panel with information about the player's current location." (let* ((p (coord (first me) (second me))) (descr (when p (break-lines (describe-patch p) (- (.width win) 2))))) (clear win) (box win) (move win 1 1) (dolist (d descr) (add-string win d) (move win (1+ (first (.cursor-position win))) 1)) (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." ;;TODO (clear win) (move win 0 0) (add-string win (car news)) (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 'dialog-window :input-blocking t :items (mapcar #'(lambda (n) (break-lines (string-from-list (list "*" n)) 50) news) :center t :border t :layout nil :title "Game messages" :max-item-length 50)))) ;:scrolled-layout '(10 1) ;; :message-height 2 ;; :message-text "Press b to go back." ;; :event-handlers '((#\b #'exit-event-loop))))) (defun process-command (event) ;;TODO ) (start-game)