;;;;
;;;; Naledi ya Africa ("Star of Africa") is an ncurses-based survival game
;;;; set in Africa.
;;;;
;;;; This file is responsible for managing player instances.
;;;; 
;;;; (c) 2018 Daniel Vedder, MIT license
;;;;

(in-package :naledi-ya-africa)

(defstruct player
	;; A registered user on the server
	(name "")
	(password "")
	(online NIL)
	(human NIL)
	(messages NIL))

(defclass human (animal)
	;; The game entity representing a human player
	;;XXX add age?
	((experience :accessor .xp :initform 0)
		(level :accessor .level :initform 0)
		(dexterity :accessor .dex :initarg :dex :initform 1)
		(intelligence :accessor .int :initarg :int :initform 1)
		(hunger :accessor .hunger :initarg :hunger :initform 10)
		(tool :accessor .tool :initarg :tool :initform NIL)
		(inventory :accessor .inventory :initarg :inventory
			:initform '((NIL 0) (NIL 0) (NIL 0) (NIL 0) (NIL 0)
						   (NIL 0) (NIL 0) (NIL 0) (NIL 0) (NIL 0))))
	;;XXX change habitats to (available-biomes)? -> requires load order change
	(:default-initargs :habitat T :char #\@ :color :white))

(defmethod update ((h human))
	;;TODO
	)

(defmethod move ((h human) dir)
	"A human moves one space in the specified direction, if possible."
	;;TODO allow for attack/explore mode
	(let ((p (get-player (.name h))))
		(case (call-next-method)
			('OUT-OF-BOUNDS (msg-player p "Out of bounds.") NIL)
			('PATCH-OCCUPIED
				(msg-player p "This patch is blocked by ~A."
					(leading-vowel (.name (patch-occupant
											  (patchindir (.x h) (.y h) dir)))))
					NIL)
			(T T))))

(defun msg-player (player msg &rest format-args)
	"Send a message to a player (adds it to the queue)"
	(setf (player-messages player)
		(append (player-messages player)
			(list (apply #'format (append (list NIL msg) format-args))))))

(defun collect-messages (player)
	"Collect this player's messages and clear the queue"
	(let ((msgs (player-messages player)))
		(setf (player-messages player) NIL)
		msgs))

;; INVENTORY HANDLING FUNCTIONS

;;TODO convert to methods

;; FIXME remove `notify' calls

(defun stock-size (resource player)
	"How many items of this resource type is the player carrying?"
	(dolist (i (player-inventory player) 0)
		(when (eq (item-name (first i)) resource)
			(return-from stock-size (second i)))))

(defun weight-carried (player)
	"Sum up the total weight of all items carried"
	(+ (item-weight (player-equipment player))
		(reduce #'+ (mapcar #'(lambda (i)
								  (* (second i) (item-weight (first i)))))
			(player-inventory player))))

(defun pickup (item player)
	"Add the item object to the inventory"
	;;Can the item be picked up at all?
	(unless (item-movable item)
		(notify "This item cannot be picked up.")
		(return-from pickup))
	;;Is the player strong enough to pick this up?
	(unless (<= (+ (item-weight item) (weight-carried player))
				(* (player-strength player) 20)) ;XXX magic number
		(notify "You are too burdened to pick this up.")
		(return-from pickup))
	(dolist (inv (player-inventory player))
		;;Resources may be stacked
		(when (and (item-resource item)
				  (eq (item-name item) (item-name (first inv))))
			(incf (second inv))
			(notify "You have picked up one ~A." (item-name item))
			(return-from pickup))
		;;Deposit the item in an empty slot
		(when (and (null (first inv)) (item-resource item) ;normal pickup
				  ;;XXX replace with find-if
				  (zerop (count-instances (item-name item) 
							 (mapcar #'(lambda (i) (item-name (car i)))))))
			(setf inv (list item 1))
			(notify "You have picked up one ~A." (item-name item))
			(return-from pickup)))
	;;If nothing has worked, the inventory is full
	(notify "Your inventory is full."))

(defun drop (player inv-nr)
	"Drop an item from the given inventory index"
	;;TODO add item back to patch
	(let* ((item-entry (nth inv-nr (player-inventory player)))
			  (item (when item-entry (first item-entry))))
		(if (and item (> (stock-size (item-name item) 1)))
			(decf (second item-entry))
			(setf item NIL (second item-entry) 0))))