Newer
Older
naledi / server / item-methods.lisp
;;;;
;;;; Naledi ya Africa ("Star of Africa") is an ncurses-based survival game
;;;; set in Africa.
;;;;
;;;; This file defines all CLOS methods used in the game for the different
;;;; item classes.
;;;; 
;;;; (c) 2018 Daniel Vedder, MIT license
;;;;

(in-package :naledi-ya-africa)

(defmethod move ((a animal) dir)
	"An animal moves one space in the specified direction, if possible"
	(let* ((here (coord (.x a) (.y a)))
			  (target (coordsindir (.x a) (.y a) dir))
			  (target-patch (coord (first target) (second target))))
		(cond ((null target-patch)
				  (logf 3 "~S is attempting to move out of bounds ~S" a target)
				  'OUT-OF-BOUNDS)
			((patch-occupant target-patch)
				(logf 3 "~S is moving onto occupied patch ~S (~S)"
					a target (patch-occupant target-patch))
				'PATCH-OCCUPIED)
			(T (setf (patch-occupant here) NIL)
				(setf (patch-occupant target-patch) a)
				(setf (.x a) (first target) (.y a) (second target))
				T))))

;; Default `update' and `action' methods are NOP
(defmethod update ((i item)))
(defmethod action ((i item)))

(defmethod attack ((d destructable) (tl tool))
	"Attack a destructable item with a tool or weapon"
	;;Returns either the damaged item or the items it drops when destroyed
	(if (member (class-of tl) (.destructors d))
		(if (>= 0 (decf (.health d) (random (* 10 (.level tl)))))
			(.drops d) d)
		(progn (notify "You cannot attack ~A with ~A."
				   (leading-vowl (.name d)) (leading-vowel (.name tl)))
			NIL)))

;;TODO (defmethod attack ((f feature) (tl tool)))
;;TODO (defmethod attack ((a animal) (w weapon)))

(defmethod update ((a animal))
	(when (> (age-of-the-world) (.last-move a))
		(random-move a)
		(incf (.last-move a))))
	
(defmethod random-move ((a animal))
	"Move in a random direction within the species' habitat niche"
	;;TODO rewrite with `move'
	(do* ((dir (random-elt *directions*) (random-elt *directions*))
			 (next-patch (patchindir (.x a) (.y a) dir)
				 (patchindir (.x a) (.y a) dir))
			 (ttl 10 (1- ttl)))
		((zerop ttl)
			NIL)
		(when (and next-patch (null (patch-occupant next-patch))
				  (member (read-from-string
							  (biome-name (patch-biome next-patch)))
					  (.habitat a)))
			(setf (patch-occupant (coord (.x a) (.y a))) NIL)
			(setf (.x a) (first (patch-pos next-patch))
				(.y a) (second (patch-pos next-patch)))
			(setf (patch-occupant next-patch) a)
			(return-from random-move a))))