;;;; Naledi ya Africa ("Star of Africa") is an ncurses-based survival game
;;;; set in Africa.
;;;; This file defines patches and administrates the world object.
;;;; (c) 2018 Daniel Vedder, MIT license
(defconstant *directions* '(N NE E SE S SW W NW))
(pos '(0 0)) ;position
(features '()) ;an alist of possible features and their 1/p probabilities
(char #\.) ;default map display character
(col ':white)) ;default map display colour
;; BIOME LIST
(let ((biome-list NIL))
(defun register-biome (symbol-name biome-object)
(setf biome-list (cons (list symbol-name biome-object) biome-list)))
(defun available-biomes ()
(defun get-biome (symbol-name)
(cassoc symbol-name biome-list)))
(defmacro new-biome (name &body body)
:name ,(symbol-to-string name)
;; MATRIX FUNCTIONS
(defun init-matrix (size)
"Create a square matrix of empty patches"
;;TODO change this to arrays for performance
(debugging "~&Creating a ~S/~S matrix." size size)
(do ((y 0 (1+ y)) (world NIL) (row NIL NIL))
((= y size) world)
(dotimes (x size)
(setf row (append row (list (make-patch :pos (list x y))))))
(setf world (append world (list row)))))
(defun distance (x1 y1 x2 y2 &optional (pythag NIL))
"Find the distance between two sets of coordinates"
(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 &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) abs-dist))
(when c (distance (first here) (second here)
(first c) (second c) abs-dist)))
(mindist dist) (closest c))
((null clist) closest)
(when (< dist mindist)
(setf mindist dist closest c))))
(defun opposite-dir (dir)
"Return the direction opposite the input"
(let ((pos (position dir *directions*)))
(when pos (nth (rem (+ 4 pos) 8) *directions*))))
(defun next-dir (dir &optional (cw T))
"Get the neighbouring direction (clockwise or anticlockwise)"
(let ((pos (position dir *directions*))
(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)
(cond ((> herey therey) 'NW)
((< herey therey) 'SW)
((< herex therex)
(cond ((> herey therey) 'NE)
((< herey therey) 'SE)
(T (cond ((> herey therey) 'N)
((< herey therey) 'S)
(defun coordsindir (x y dir)
"Return the coordinates in the given direction"
(cond ((eq dir 'N) (list x (1- y)))
((eq dir 'NE) (list (1+ x) (1- y)))
((eq dir 'E) (list (1+ x) y))
((eq dir 'SE) (list (1+ x) (1+ y)))
((eq dir 'S) (list x (1+ y)))
((eq dir 'SW) (list (1- x) (1+ y)))
((eq dir 'W) (list (1- x) y))
((eq dir 'NW) (list (1- x) (1- y)))
((null dir) (list x y))
(T (error "~&Invalid direction ~S"))))
(defun patchindir (x y dir)
"Return the patch in the given direction"
(let* ((coords (coordsindir x y dir))
(nextx (first coords)) (nexty (second coords)))
(coord nextx nexty)))
(defun neighbour (p dir)
"Return the neighbouring patch in this direction"
(patchindir (first (patch-pos p)) (second (patch-pos p)) dir))
;; WORLD CREATION FUNCTIONS
(defun get-patch-feature (patch)
"Find a random feature (or none) to occupy this patch."
(let ((flist (biome-features (patch-biome patch))))
(dolist (f flist NIL)
(when (chancep (second f))
(make-instance (first f) :x (first (patch-pos patch))
:y (second (patch-pos patch))))))))
(defun generate-biomes (size-factor)
;;XXX The maps this produces don't look quite as expected, but for
;; current purposes they are good enough
(debugging "~&Generating biomes") ;debug
(let* ((wsize (world-size)) (seeds NIL)
(nseeds (round (/ wsize size-factor)))
#'(lambda (e) (eq e 'stream))
;;Initialize a set of biome 'seed' coordinates
(dotimes (n nseeds)
(cons (list (random wsize)
(debugging "~&~S" seeds)
;;For each patch, calculate the closest seed and set to that biome
(dotimes (x wsize seeds)
(dotimes (y wsize)
(let ((p (coord x y))
(b (third (closest-coords (list x y) seeds T))))
(setf (patch-biome p) (get-biome b))
(setf (patch-occupant p) (get-patch-feature p)))))))
(defun generate-stream (x0 y0)
(debugging "~&Generating a stream, starting at ~S/~S" x0 y0) ;debug
(do* ((dir (random-elt *directions*)
(if (probabilityp 75) dir (next-dir dir (random-elt '(T NIL)))))
(patch (coord x0 y0) (neighbour patch dir)))
((or (null patch) (eq (patch-biome patch) (get-biome 'stream))))
(setf (patch-biome patch) (get-biome 'stream))
(setf (patch-occupant patch) NIL)))
(defun create-world (size)
"Create a world of the specified size (square)"
(set-world (init-matrix size))
;;XXX magic numbers
(dotimes (s (round (/ (expt size 2) 2000)))
(generate-stream (random size) (random size))))
(defun init-world ()
"Initialize the log, RNG, and world."
(write-to-file "NALEDI ya AFRICA" *logfile*)
(setf *random-state* (make-random-state t))
(defun describe-patch (p)
"Return a list of lines describing this patch."
(list (string-upcase (biome-name (patch-biome p))) ""
(format NIL "~A / ~A" (first (patch-pos p)) (second (patch-pos p))) ""
(format NIL "The ground here is ~A." (biome-ground (patch-biome p)))
(when (patch-occupant p)
(format NIL "There is ~A here."
(leading-vowel (.name (patch-occupant p)))))
(when (patch-items p)
;;FIXME we will be dealing with instances here, not names...
(format NIL "The following items are here:~A *~A" #\newline
(string-from-list (mapcar #'.name (patch-items p))
(format NIL "~% *"))))))