;;;
;;; Atlantis is a framework for creating multi-user dungeon worlds.
;;; This is the Common Lisp implementation.
;;;
;;; This file contains all the various kinds of in-game objects like
;;; places, monsters, NPCs, items...
;;;
;;; Licensed under the terms of the MIT license.
;;; author: Daniel Vedder
;;; date: 15/05/2015
;;;

(defstruct place
	(name "")
	(description "")
	;; Missing 's' in the following list names due to parsing issues
	(neighbour NIL)
	(player NIL)
	(item NIL)
	(monster NIL)
	(npc NIL)
	(dark NIL)
	(function ""))

;;; WORK IN PROGRESS >>>

(defstruct npc
	(name "")
	(description "")
	(says "")
	(sells NIL)
	(quest ""))

(defstruct monster
	(name "")
	(description "")
	(health 0)
	(strength 0)
	(dexterity 0)
	(aggression 0)
	(spawn-probability 0)
	(weapon "")
	(armour-class 0))

(defstruct item
	(name "")
	(description "")
	(cost 0)
	(weapon "no")
	(function NIL))

(defstruct weapon
	(name "")
	(description "")
	(type "")
	(damage 0))

(defstruct quest
	(name "")
	(say-before "")
	(say-after "")
	(proof-item NIL)
	(reward-item NIL)
	(money 0)
	(experience 0))

(defstruct game-function
	(name "")
	(docstring "")
	(place NIL)
	(player NIL)
	(print ""))

(defun set-object-attribute (game-object property value)
	"Set the attribute 'property' of 'game-object' to 'value'"
	;; Here follows Lisp magic :D      (that took ages to get right...)
	;; XXX It's not elegant to call (eval) explicitly, but in this case I can't
	;; find a way to avoid it - I needed a mix between a macro and a function
	(let ((command (build-symbol (type-of game-object) "-" property)))
		(eval `(if (or (null (,command ,game-object))
					   (listp (,command ,game-object)))
				   (setf (,command ,game-object)
					   (append (,command ,game-object) '(,value)))
				   (setf (,command ,game-object) ,value)))))

(defun remove-object-attribute (game-object property value)
	"Remove 'value' from the attribute 'property' in 'game-object'"
	;; Same comment applies as above
	(let ((command (build-symbol (type-of game-object) "-" property)))
		(eval `(cond ((listp (,command ,game-object))
						 (setf (,command ,game-object)
							 (remove-first-if #'(lambda (x) (equalp x ,value))
								 (,command ,game-object))))
				   ((numberp (,command ,game-object))
					   (setf (,command ,game-object) 0))
				   ((stringp (,command ,game-object))
					   (setf (,command ,game-object) ""))
				   (t (setf (,command ,game-object) NIL))))))

(defun objectify-name-list (object-type name-list)
	"Turn all the string names in name-list into instances of the object type"
	;; Basically the inverse of a make-list-function function (cf. util.lisp)
	(let ((objects NIL) (copy-fn (build-symbol "copy-" object-type)))
		(dolist (n name-list objects)
			(if (stringp n)
				(setf objects
					(cons (funcall copy-fn (get-game-object object-type n))
							  objects))
				(setf objects (cons n objects))))))

(defun objectify-place-monsters (place)
	"Objectify all the monsters in this place"
	(let* ((p (if (place-p place) place (get-game-object 'place place))))
		(setf (place-monster p)
			(objectify-name-list 'monster (place-monster p)))
		p))
		
	
(let ((list-function (make-list-function 'place NIL)))
	(defun list-place-objects (object-type place)
		"Get a list of the names of all the place's objects of this type."
		(funcall list-function object-type place)))

(defun get-object-description (object-name place)
	"Get a description of this object in place (or nil if not there)"
	(let ((p (if (place-p place) place (get-game-object 'place place))))
		(cond ((member object-name (list-place-objects 'item p) :test #'equalp)
				  (item-description (get-game-object 'item object-name)))
			((member object-name (list-place-objects 'monster p) :test #'equalp)
				(monster-description (get-game-object 'monster object-name)))
			((member object-name (list-place-objects 'npc p) :test #'equalp)
				(npc-description (get-game-object 'npc object-name)))
			(t NIL))))
		
(defun run-game-function (function player)
	"Execute this game function"
	(let* ((fn (if (game-function-p function) function
				   (get-game-object 'game-function function)))
			  (player (if (player-p player) player
						  (get-game-object 'player player)))
			  (place (get-game-object 'place (player-place player))))
		(dolist (game-obj (list player place))
			;; Iterate through each element in the function that modifies
			;; this game object
			(dolist (element (funcall (build-symbol "game-function-"
										  (type-of game-obj)) fn))
				(let* ((element (if (listp element) element (list element)))
						  (attr (first element)) (value (second element))
						  ;; FIXME +1 gets transformed to "1"...
						  (mod (aref (to-string value) 0))
						  (orig-value (funcall (build-symbol (type-of game-obj)
												   #\- attr) game-obj)))
					;; Update the value of the specified attribute
					(if (= (length element) 1)
						(set-object-attribute game-obj attr T)
						(if (or (eq mod #\+) (eq mod #\-))
							(set-object-attribute game-obj attr
								(+ orig-value value))
							(set-object-attribute game-obj attr value))))))))