;;;; ;;;; Naledi ya Africa ("Star of Africa") is a rogue-like survival game ;;;; set in Africa. ;;;; ;;;; This is the main program file with the user interface. ;;;; ;;;; (c) 2018 Daniel Vedder, MIT license ;;;; (defvar *debugging* T) (ql:quickload :croatoan) (use-package :croatoan) (load "util.lisp") (load "classes.lisp") (load "items.lisp") (load "biomes.lisp") (load "animals.lisp") (load "world.lisp") (defun user-interface () "Create the screen on the ncurses interface and hand over to window functions" ;;TODO (with-screen (scr :input-echoing nil :input-blocking t :enable-colors t :cursor-visibility nil :input-reading :unbuffered) (let* ((width (.width scr)) (height (1- (.height scr))) (me (list (round (/ width 4)) (halve height)))) (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) (refresh scr) (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" ;;TODO implement missing functions (draw-map mapwin me) (draw-player-panel playerwin) (draw-place-panel placewin) (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) (setf (.cursor-position win) '(1 1)) (let ((x0 (- (first me) (round (/ (.width win) 2)))) (y0 (- (second me) (round (/ (.height win) 2))))) (dotimes (h (- (.height win) 1)) (dotimes (w (- (floor (/ (.width win) 2)) 1)) (let ((p (coord (+ w x0 1) (+ 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 #\X)) (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))) (setf (.cursor-position win) (list (+ h 1) 1))) (refresh win))) (defun draw-player-panel (win) "Draw a panel with information about the player character." ;;TODO (box win) (setf (.cursor-position win) '(1 1)) (add-string win "This is the player panel.") (refresh win)) (defun draw-place-panel (win) "Draw a panel with information about the player's current location." ;;TODO (box win) (setf (.cursor-position win) '(1 1)) (add-string win "This is the place panel.") (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) (setf (.cursor-position win) '(0 0)) (add-string win (car news)) (refresh win)) (defun notify (news-string) "Append a string to the news to notify the user." ;;FIXME This needs to support (format) (setf news (cons news-string news))) (defun message-window () "Return a dialog window with the last game messages." (make-instance 'dialog-window :input-blocking t :items (mapcar #'(lambda (n) (string-from-list (list "*" n) " ")) 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 ) ;; Initialize the random state (which would otherwise not be very random...) (setf *random-state* (make-random-state t)) (setf *world* (create-world 500)) (user-interface)