diff --git a/ncurses_example.lisp b/ncurses_example.lisp new file mode 100644 index 0000000..2c58448 --- /dev/null +++ b/ncurses_example.lisp @@ -0,0 +1,16 @@ + +(in-package :croatoan) + +(defun test1 () + (with-screen (scr :input-echoing nil :input-blocking t :enable-colors t) + (clear scr) + (move scr 2 0) + (format scr "Type chars. Type q to quit.~%~%") + (refresh scr) + (setf (.color-pair scr) '(:yellow :red) + (.attributes scr) '(:bold)) + (event-case (scr event) + (#\q (return-from event-case)) + (otherwise (princ event scr) + (refresh scr))))) + diff --git a/ncurses_example.lisp b/ncurses_example.lisp new file mode 100644 index 0000000..2c58448 --- /dev/null +++ b/ncurses_example.lisp @@ -0,0 +1,16 @@ + +(in-package :croatoan) + +(defun test1 () + (with-screen (scr :input-echoing nil :input-blocking t :enable-colors t) + (clear scr) + (move scr 2 0) + (format scr "Type chars. Type q to quit.~%~%") + (refresh scr) + (setf (.color-pair scr) '(:yellow :red) + (.attributes scr) '(:bold)) + (event-case (scr event) + (#\q (return-from event-case)) + (otherwise (princ event scr) + (refresh scr))))) + diff --git a/terranostra.lisp b/terranostra.lisp index 99f4696..60045ad 100644 --- a/terranostra.lisp +++ b/terranostra.lisp @@ -24,21 +24,41 @@ ;;TODO (with-screen (scr :input-echoing nil :input-blocking t :enable-colors t :cursor-visibility nil :input-reading :unbuffered) - (let* ((width (.width scr)) (height (.height scr)) - (me (list (round (/ width 4)) (round (/ height 2))))) + (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 (floor (/ width 2)) :height height) - (infowin :position (list 0 (floor (/ width 2))) + :width (halve width 'down) :height height) + (playerwin :position (list 0 (halve width 'down)) :input-blocking t :border t - :width (ceiling (/ width 2)) :height height)) - (draw-map mapwin me) - (draw-info-panel infowin) + :width (halve width 'up) + :height (halve height 'down)) + (placewin :input-blocking t :border t + :position (list (halve height) + (halve width 'down)) + :width (halve width 'up) + :height (halve height 'down)) + (newswin :input-blocking t + :position (list height 0) + :width width :height 1)) + (update-ui mapwin playerwin placewin newswin me) (event-case (scr event) (#\q (return-from event-case)) - (:up (decf (second me)) (draw-map mapwin me)) - (:down (incf (second me)) (draw-map mapwin me)) - (:left (decf (first me)) (draw-map mapwin me)) - (:right (incf (first me)) (draw-map mapwin me))))))) + (: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))))))) + +(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" @@ -49,7 +69,7 @@ (let ((x0 (- (first me) (round (/ (.width win) 2)))) (y0 (- (second me) (round (/ (.height win) 2))))) (dotimes (h (- (.height win) 1)) - (dotimes (w (- (.width win) 2)) + (dotimes (w (- (floor (/ (.width win) 2)) 1)) (let ((p (coord (+ w x0 1) (+ h y0 1)))) (if (null p) (add-char win #\space) ;;TODO draw features @@ -61,16 +81,32 @@ (setf (.color-pair win) (list (biome-col (patch-biome p)) :black)) (add-char win - (biome-char (patch-biome p)))))))) - (setf (.cursor-position win) (list (+ h 1) 1)) - (refresh win)))) + (biome-char (patch-biome p)))))) + (add-char win #\space))) + (setf (.cursor-position win) (list (+ h 1) 1))) + (refresh win))) -(defun draw-info-panel (win) - "Draw the info panel and associated information in an ncurses window" +(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 information panel.") + (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)) + +(defun draw-news-panel (win) + "Draw a thin panel at the bottom of the screen to display news items." + ;;TODO + (setf (.cursor-position win) '(0 0)) + (add-string win "This is the news panel.") (refresh win)) (defun process-command (event) @@ -79,5 +115,5 @@ ;; Initialize the random state (which would otherwise not be very random...) (setf *random-state* (make-random-state t)) -(setf *world* (create-world 100)) +(setf *world* (create-world 200)) (user-interface) diff --git a/ncurses_example.lisp b/ncurses_example.lisp new file mode 100644 index 0000000..2c58448 --- /dev/null +++ b/ncurses_example.lisp @@ -0,0 +1,16 @@ + +(in-package :croatoan) + +(defun test1 () + (with-screen (scr :input-echoing nil :input-blocking t :enable-colors t) + (clear scr) + (move scr 2 0) + (format scr "Type chars. Type q to quit.~%~%") + (refresh scr) + (setf (.color-pair scr) '(:yellow :red) + (.attributes scr) '(:bold)) + (event-case (scr event) + (#\q (return-from event-case)) + (otherwise (princ event scr) + (refresh scr))))) + diff --git a/terranostra.lisp b/terranostra.lisp index 99f4696..60045ad 100644 --- a/terranostra.lisp +++ b/terranostra.lisp @@ -24,21 +24,41 @@ ;;TODO (with-screen (scr :input-echoing nil :input-blocking t :enable-colors t :cursor-visibility nil :input-reading :unbuffered) - (let* ((width (.width scr)) (height (.height scr)) - (me (list (round (/ width 4)) (round (/ height 2))))) + (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 (floor (/ width 2)) :height height) - (infowin :position (list 0 (floor (/ width 2))) + :width (halve width 'down) :height height) + (playerwin :position (list 0 (halve width 'down)) :input-blocking t :border t - :width (ceiling (/ width 2)) :height height)) - (draw-map mapwin me) - (draw-info-panel infowin) + :width (halve width 'up) + :height (halve height 'down)) + (placewin :input-blocking t :border t + :position (list (halve height) + (halve width 'down)) + :width (halve width 'up) + :height (halve height 'down)) + (newswin :input-blocking t + :position (list height 0) + :width width :height 1)) + (update-ui mapwin playerwin placewin newswin me) (event-case (scr event) (#\q (return-from event-case)) - (:up (decf (second me)) (draw-map mapwin me)) - (:down (incf (second me)) (draw-map mapwin me)) - (:left (decf (first me)) (draw-map mapwin me)) - (:right (incf (first me)) (draw-map mapwin me))))))) + (: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))))))) + +(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" @@ -49,7 +69,7 @@ (let ((x0 (- (first me) (round (/ (.width win) 2)))) (y0 (- (second me) (round (/ (.height win) 2))))) (dotimes (h (- (.height win) 1)) - (dotimes (w (- (.width win) 2)) + (dotimes (w (- (floor (/ (.width win) 2)) 1)) (let ((p (coord (+ w x0 1) (+ h y0 1)))) (if (null p) (add-char win #\space) ;;TODO draw features @@ -61,16 +81,32 @@ (setf (.color-pair win) (list (biome-col (patch-biome p)) :black)) (add-char win - (biome-char (patch-biome p)))))))) - (setf (.cursor-position win) (list (+ h 1) 1)) - (refresh win)))) + (biome-char (patch-biome p)))))) + (add-char win #\space))) + (setf (.cursor-position win) (list (+ h 1) 1))) + (refresh win))) -(defun draw-info-panel (win) - "Draw the info panel and associated information in an ncurses window" +(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 information panel.") + (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)) + +(defun draw-news-panel (win) + "Draw a thin panel at the bottom of the screen to display news items." + ;;TODO + (setf (.cursor-position win) '(0 0)) + (add-string win "This is the news panel.") (refresh win)) (defun process-command (event) @@ -79,5 +115,5 @@ ;; Initialize the random state (which would otherwise not be very random...) (setf *random-state* (make-random-state t)) -(setf *world* (create-world 100)) +(setf *world* (create-world 200)) (user-interface) diff --git a/util.lisp b/util.lisp index c645166..f4b4398 100644 --- a/util.lisp +++ b/util.lisp @@ -84,6 +84,13 @@ "Compute the average of the given numbers" (/ (reduce #'+ numbers) (length numbers))) +(defun halve (n &optional (round-fn 'round)) + "Halve a given number and round it to an integer." + (let ((half (/ n 2))) + (cond ((eq round-fn 'up) (ceiling half)) + ((eq round-fn 'down) (floor half)) + (T (round half))))) + (defun keys (assoc-list) "Return a list of the keys in an association list" (if (null assoc-list) NIL diff --git a/ncurses_example.lisp b/ncurses_example.lisp new file mode 100644 index 0000000..2c58448 --- /dev/null +++ b/ncurses_example.lisp @@ -0,0 +1,16 @@ + +(in-package :croatoan) + +(defun test1 () + (with-screen (scr :input-echoing nil :input-blocking t :enable-colors t) + (clear scr) + (move scr 2 0) + (format scr "Type chars. Type q to quit.~%~%") + (refresh scr) + (setf (.color-pair scr) '(:yellow :red) + (.attributes scr) '(:bold)) + (event-case (scr event) + (#\q (return-from event-case)) + (otherwise (princ event scr) + (refresh scr))))) + diff --git a/terranostra.lisp b/terranostra.lisp index 99f4696..60045ad 100644 --- a/terranostra.lisp +++ b/terranostra.lisp @@ -24,21 +24,41 @@ ;;TODO (with-screen (scr :input-echoing nil :input-blocking t :enable-colors t :cursor-visibility nil :input-reading :unbuffered) - (let* ((width (.width scr)) (height (.height scr)) - (me (list (round (/ width 4)) (round (/ height 2))))) + (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 (floor (/ width 2)) :height height) - (infowin :position (list 0 (floor (/ width 2))) + :width (halve width 'down) :height height) + (playerwin :position (list 0 (halve width 'down)) :input-blocking t :border t - :width (ceiling (/ width 2)) :height height)) - (draw-map mapwin me) - (draw-info-panel infowin) + :width (halve width 'up) + :height (halve height 'down)) + (placewin :input-blocking t :border t + :position (list (halve height) + (halve width 'down)) + :width (halve width 'up) + :height (halve height 'down)) + (newswin :input-blocking t + :position (list height 0) + :width width :height 1)) + (update-ui mapwin playerwin placewin newswin me) (event-case (scr event) (#\q (return-from event-case)) - (:up (decf (second me)) (draw-map mapwin me)) - (:down (incf (second me)) (draw-map mapwin me)) - (:left (decf (first me)) (draw-map mapwin me)) - (:right (incf (first me)) (draw-map mapwin me))))))) + (: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))))))) + +(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" @@ -49,7 +69,7 @@ (let ((x0 (- (first me) (round (/ (.width win) 2)))) (y0 (- (second me) (round (/ (.height win) 2))))) (dotimes (h (- (.height win) 1)) - (dotimes (w (- (.width win) 2)) + (dotimes (w (- (floor (/ (.width win) 2)) 1)) (let ((p (coord (+ w x0 1) (+ h y0 1)))) (if (null p) (add-char win #\space) ;;TODO draw features @@ -61,16 +81,32 @@ (setf (.color-pair win) (list (biome-col (patch-biome p)) :black)) (add-char win - (biome-char (patch-biome p)))))))) - (setf (.cursor-position win) (list (+ h 1) 1)) - (refresh win)))) + (biome-char (patch-biome p)))))) + (add-char win #\space))) + (setf (.cursor-position win) (list (+ h 1) 1))) + (refresh win))) -(defun draw-info-panel (win) - "Draw the info panel and associated information in an ncurses window" +(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 information panel.") + (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)) + +(defun draw-news-panel (win) + "Draw a thin panel at the bottom of the screen to display news items." + ;;TODO + (setf (.cursor-position win) '(0 0)) + (add-string win "This is the news panel.") (refresh win)) (defun process-command (event) @@ -79,5 +115,5 @@ ;; Initialize the random state (which would otherwise not be very random...) (setf *random-state* (make-random-state t)) -(setf *world* (create-world 100)) +(setf *world* (create-world 200)) (user-interface) diff --git a/util.lisp b/util.lisp index c645166..f4b4398 100644 --- a/util.lisp +++ b/util.lisp @@ -84,6 +84,13 @@ "Compute the average of the given numbers" (/ (reduce #'+ numbers) (length numbers))) +(defun halve (n &optional (round-fn 'round)) + "Halve a given number and round it to an integer." + (let ((half (/ n 2))) + (cond ((eq round-fn 'up) (ceiling half)) + ((eq round-fn 'down) (floor half)) + (T (round half))))) + (defun keys (assoc-list) "Return a list of the keys in an association list" (if (null assoc-list) NIL diff --git a/world.lisp b/world.lisp index 5f79f46..4fbd4db 100644 --- a/world.lisp +++ b/world.lisp @@ -32,18 +32,18 @@ (unless (or (< x 0) (< y 0) (> x (length world)) (> y (length world))) (nth x (nth y world)))) -(defun distance (x1 y1 x2 y2) +(defun distance (x1 y1 x2 y2 &optional (pythag NIL)) "Find the distance between two sets of coordinates" - ;;Ignores Pythagoras - (min (abs (- x1 x2)) (abs (- y1 y2)))) + (if pythag (round (sqrt (+ (expt (- x1 x2) 2) (expt (- y1 y2) 2)))) + (min (abs (- x1 x2)) (abs (- y1 y2))))) -(defun closest-coords (here coord-list) +(defun closest-coords (here coord-list &optional (abs-dist NIL)) "Find the closest position to 'here' from a list of coordinates" (do* ((clist coord-list (cdr clist)) (c (car clist) (car clist)) (dist (when c (distance (first here) (second here) - (first c) (second c))) + (first c) (second c) abs-dist)) (when c (distance (first here) (second here) - (first c) (second c)))) + (first c) (second c) abs-dist))) (mindist dist) (closest c)) ((null clist) closest) (when (< dist mindist) @@ -60,6 +60,14 @@ (diff (if cw 1 -1))) (when pos (nth (rem (+ diff pos 8) 8) *directions*)))) +(defun orth-dir (dir &optional (cw T)) + "Get the direction orthogonal (at right angles) to the given one." + (next-dir (next-dir dir cw) cw)) + +(defun diagonalp (dir) + "Is dir a diagonal direction?" + (member dir '(NE SE SW NW) :test #'eq)) + (defun dir2patch (herex herey therex therey) "Calculate the direction to a patch" (cond ((> herex therex) @@ -134,22 +142,36 @@ ;;For each patch, calculate the closest seed and set to that biome (dotimes (x world-size) (dotimes (y world-size) - (let ((b (third (closest-coords (list x y) seeds)))) + (let ((b (third (closest-coords (list x y) seeds T)))) (setf (patch-biome (coord x y world)) (get-biome b))))))) (defun generate-stream (x0 y0 world) (debugging "~&Generating a stream, starting at ~S/~S" x0 y0) ;debug (do* ((dir (random-elt *directions*) - (if (probabilityp 60) dir (next-dir dir (random-elt '(T NIL))))) + (if (probabilityp 75) dir (next-dir dir (random-elt '(T NIL))))) (patch (coord x0 y0 world) (neighbour patch dir world))) ((or (null patch) (eq (patch-biome patch) (get-biome 'stream)))) (setf (patch-biome patch) (get-biome 'stream)))) + +(defun generate-stream-broad (x0 y0 world &optional (broad NIL)) + (debugging "~&Generating a stream, starting at ~S/~S" x0 y0) ;debug + ;;FIXME adjacent needs a second one if going diagonally + (do* ((dir (random-elt *directions*) + (if (probabilityp 75) dir (next-dir dir (random-elt '(T NIL))))) + (patch (coord x0 y0 world) (neighbour patch dir world)) + (adjacent (when patch (neighbour patch (if (diagonalp dir) (next-dir dir) (orth-dir dir)) world)) + (when patch (neighbour patch (if (diagonalp dir) (next-dir dir) (orth-dir dir)) world)))) + ((or (null patch) (eq (patch-biome patch) (get-biome 'stream)))) + (setf (patch-biome patch) (get-biome 'stream)) + (when (and broad adjacent) + (debugging "~&~S~%~S" (patch-pos patch) (patch-pos adjacent)) + (setf (patch-biome adjacent) (get-biome 'stream))))) (defun create-world (size) (let ((world (init-matrix size))) ;;XXX magic numbers - (generate-biomes 20 world) - (dotimes (s (round (/ (expt size 2) 500))) + (generate-biomes 10 world) + (dotimes (s (round (/ (expt size 2) 1000))) (generate-stream (random size) (random size) world)) world))