;; spells.lisp --- Part of srd-tools

;; Copyright (C) 2008 Clinton Ebadi <clinton@unknownlamer.org>

;; Author: Clinton Ebadi <clinton@unknownlamer.org>

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.


(in-package :org.unknownlamer.dnd-tools)

(defclass spell-level ()
  ((level :initarg :spell-level :accessor spell-level :index t)
   (caster-level :initarg :caster-level :accessor caster-level :index t))
  (:metaclass persistent-metaclass))

(defclass spell-domain-level (spell-level)
  ((domain :initarg :domain :accessor spell-domain :index t))
  (:metaclass persistent-metaclass))

(defclass spell-domain ()
  ((name :initarg :name :accessor spell-domain-name :index t)
   (levels :initarg :domain-levels :accessor spell-domain-levels))
  (:metaclass persistent-metaclass))

(defclass spell-school ()
  ((name :initarg :name :accessor spell-school-name :index t))
  (:metaclass persistent-metaclass))

(defgeneric spell-school-subschools (spell-school))
(defgeneric spell-subschool-name (spell-school))

(defmethod spell-subschool-name ((s spell-school)) nil)
(defmethod spell-school-subschools ((spell-school spell-school))
  (get-instances-by-value 'spell-subschool 'school spell-school))

(defclass spell-subschool ()
  ((name :initarg :name :accessor spell-subschool-name :index t)
   (school :initarg :school :accessor spell-school :index t))
  (:metaclass persistent-metaclass))

(defclass spell-descriptor ()
  ((name :initarg :name :accessor spell-descriptor-name :index t))
  (:metaclass persistent-metaclass))

(defclass spell-component ()
  ((name :initarg :name :accessor spell-component-name :index t)
   (abbreviation :initarg :abbreviation :accessor spell-component-abbreviation
		 :index t))
  (:metaclass persistent-metaclass))

(defclass spell ()
  ((name :initarg :name :accessor spell-name :index t)
   (levels :initarg :levels :accessor spell-levels)
   (school :initarg :school :accessor spell-school :index t)
   (alignment :initarg :alignment :accessor spell-alignment :index t)
   (descriptors :initarg :descriptors :accessor spell-descriptors)
   (components :initarg :components :accessor spell-components)
   (divine-alternatives :initarg :divine-alternatives
			:accessor spell-divine-alternatives)
   (casting-time :initarg :casting-time :accessor spell-casting-time)
   (range :initarg :range :accessor spell-range)
   (effect :initarg :effect :accessor spell-effect)
   (duration :initarg :duration :accessor spell-duration)
   (saving-throw :initarg :saving-throw :accessor spell-saving-throw)
   (resistance :initarg :resistance :accessor spell-resistance)
   (description :initarg :description :accessor spell-description)
   ;;; Optimizations
   (%divine-components-cache))
  (:metaclass persistent-metaclass))

(defmethod arcane-spell-components ((spell spell))
  (spell-components spell))

(defmethod divine-spell-components ((spell spell))
  (if (slot-boundp spell '%divine-components-cache)
      (slot-value spell '%divine-components-cache)
      (setf (slot-value spell '%divine-components-cache)
	    (let ((merged (make-pset :pset (spell-components spell))))
	      (if-bind alternatives (spell-divine-alternatives spell)
		(map-pset (lambda (a)
			    (remove-item (car a) merged)
			    (insert-item (cdr a) merged))
			  alternatives))
	      merged))))

(defmethod shared-initialize :after ((self spell) slot-names
				     &rest args
				     &key &allow-other-keys)
  (cond ((and (not (member :from-oid args))
	      (member :levels args))
	 (update-spell-level<->spell-index self))))

(defmethod (setf spell-levels) :after (new (spell spell))
  (update-spell-level<->spell-index spell))

(defmethod drop-pobject :before ((spell spell))
  (drop-instances (get-instances-by-value 'spell-level<->spell 'spell spell)))

(defclass alternative-object-mixin ()
  ((alternate-instance :initarg :alternative
		       :accessor alternate-object :index t)
   (kind :initarg :kind :initform :alternative
	 :type (member :alternative :additional)
	 :accessor compound-kind :index t))
  (:metaclass persistent-metaclass))

(defclass spell-compound-descriptor (spell-descriptor alternative-object-mixin)
  ()
  (:metaclass persistent-metaclass)
  (:documentation "FOO or BAR descriptor; spell may be qualified by
  either descriptor depending upon context"))

(defmethod alternative-descriptor-p ((sd spell-descriptor))
  nil)

(defmethod alternative-descriptor-p ((sd spell-compound-descriptor))
  t)

(defclass spell-compound-subschool (spell-subschool alternative-object-mixin)
  ()
  (:metaclass persistent-metaclass))

(defmethod alternative-subschool-p ((s spell-school))
  nil)

(defmethod alternative-subschool-p ((s spell-school))
  nil)

(defmethod alternative-subschool-p ((s spell-compound-subschool))
  (eq (compound-kind s) :alternative))

(defmethod additional-subschool-p ((s spell-compound-subschool))
  (eq (compound-kind s) :additional))