;; queries.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)

;;; Methods for finding various core database instances. These should all
;;; return two values like get-instance-by-value: (object found?)

;;; Anything that takes a symbol as an argument and then looks up a
;;; class from that to use as an argument to a recursive call needs an
;;; (eql nil) case for the argument to prevent infinite
;;; recursion. Damn nil being a symbol and a cons!

(defgeneric find-player-class (name))
(defgeneric find-player-level (player-class level))

(defmethod find-player-class ((name symbol))
  (get-instance-by-value 'player-class 'name name))

(defmethod find-player-level ((player-class-name symbol) level)
  (find-player-level (find-player-class player-class-name) level))

(defmethod find-player-level ((player-class player-class) (level integer))
  (get-instance-by-value 'player-level
			 'player-level->player-class
			 (cons player-class level)))

(defmethod find-player-level ((player-class (eql nil)) level)
  (values nil nil))

(defgeneric find-spell-component (name))
(defgeneric find-spell-school (school subschool))
(defgeneric find-spell-domain (name))
(defgeneric find-spell-level (player-class spell-level))
(defgeneric find-spell-domain-level (domain level))
(defgeneric find-spell-descriptor (name))

(defmethod find-spell-component ((name symbol))
  (get-instance-by-value 'spell-component 'name name))

(defmethod find-spell-school ((school-name symbol) (subschool (eql nil)))
  (get-instance-by-value 'spell-school 'name school-name))

(defmethod find-spell-school ((school-name symbol) subschool)
  (find-spell-school (find-spell-school school-name nil) subschool))

(defmethod find-spell-school ((school spell-school) (subschool symbol))
  (if-bind subschool (find subschool (spell-school-subschools school)
			   :key #'spell-subschool-name)
    (values subschool t)
    (values nil nil)))

(defmethod find-spell-school ((school (eql nil)) subschool)
  (values nil nil))

(defmethod find-spell-domain ((name symbol))
  (get-instance-by-value 'spell-domain 'name name))

(defmethod find-spell-level ((player-class-name symbol) spell-level)
  (find-spell-level (find-player-class player-class-name) spell-level))

(defmethod find-spell-level ((player-class player-class) (spell-level integer))
  ;; Inefficient; this needs a dedicated index or similar
  (get-instance-by-value 'spell-level 'spell-level->caster-class
			 (cons player-class spell-level)))

(defmethod find-spell-level ((player-class (eql nil)) spell-level)
  (values nil nil))

(defmethod find-spell-domain-level ((domain-name symbol) level)
  (find-spell-domain-level (find-spell-domain domain-name) level))

(defmethod find-spell-domain-level ((domain spell-domain) (level integer))
  (if-bind level (find-item level (spell-domain-levels domain)
			    :key #'spell-level)
    (values level t)
    (values nil nil)))

(defmethod find-spell-domain-level ((domain (eql nil)) level)
  (values nil nil))

(defmethod find-spell-descriptor ((name symbol))
  (get-instance-by-value 'spell-descriptor 'name name))

;;; Interface for spell class

(defgeneric find-spell-by-name (spell-name))
(defgeneric find-spells-by-alignment (alignment))
(defgeneric find-spells-by-school (school)
  (:documentation "Find spells within a given #<SPELL-SCHOOL> or
  #<SPELL-SUBSCHOOL>. If given a SCHOOL all spells from all subschools
  are returned."))
(defgeneric find-spells-by-caster-class (class level)
  (:documentation "Find spells usable by CLASS. If LEVEL is nil then
  find all spells for caster CLASS. LEVEL is the spell level not the
  caster level."))
(defgeneric find-spells-by-spell-level (level)
  (:documentation "Find spells at LEVEL. If LEVEL is an integer fetch
  all spells for all classes of spell level LEVEL, if LEVEL is a
  #<SPELL-LEVEL> fetch all spells for that level/class."))

(defmethod find-spell-by-name ((spell-name string))
  (get-instance-by-value 'spell 'name spell-name))

(defmethod find-spells-by-alignment ((alignment (eql nil)))
  (values nil nil))

(defmethod find-spells-by-alignment ((alignment symbol))
  (get-instances-by-value 'spell 'alignment alignment))

(defmethod find-spells-by-school ((school spell-school))
  (if-bind spells
      (append (get-instances-by-value 'spell 'school school)
	      (apply #'append
		     (mapcar #'find-spells-by-school
			     (spell-school-subschools school))))
    (values spells t)
    (values nil nil)))

(defmethod find-spells-by-school ((school spell-subschool))
  (if-bind spells (get-instances-by-value 'spell 'school school)
    (values spells t)
    (values nil nil)))

(defmethod find-spells-by-caster-class ((class symbol) level)
  (find-spells-by-caster-class (find-player-class class) level))

(defmethod find-spells-by-caster-class ((class player-class) (level integer))
  (find-spells-by-spell-level (find-spell-level class level)))

(defmethod find-spells-by-caster-class ((class player-class) (level (eql nil)))
  (apply #'append
	 (mapcar #'find-spells-by-spell-level
		 (get-instances-by-value 'spell-level
					 'spell-level->player-class
					 class))))

(defmethod find-spells-by-caster-class ((class (eql nil)) level)
  (values nil nil))

(defmethod find-spells-by-spell-level ((level spell-level))
  (mapcar #'spell
	  (get-instances-by-value 'spell-level<->spell 'level level)))

(defmethod find-spells-by-spell-level ((level integer))
  (apply #'append
	 (mapcar #'find-spells-by-spell-level
		 (get-instances-by-value 'spell-level 'level level))))


;;; Compound classes

(defgeneric find-compound-subschool (primary secondary kind &key create))
(defgeneric find-alternate-descriptor (primary secondary &key create))

(defmethod find-compound-subschool ((primary spell-subschool)
				    (secondary spell-subschool)
				    (kind symbol)
				    &key create)
  (let ((compounds (get-instances-by-value
		    'spell-compound-subschool 'name (spell-subschool-name primary))))
    (if-bind found (find-if (lambda (s) (and (eq (compound-kind s) kind)
					(eq (alternate-object s) secondary)))
			    compounds)
      (values found t)
      (if create
	  (values
	   (make-instance 'spell-compound-subschool
			  :name (spell-subschool-name primary)
			  :school (spell-school primary)
			  :kind kind
			  :alternative secondary)
	   t)
	  (values nil nil)))))


(defmethod find-alternate-descriptor ((primary spell-descriptor)
				      (secondary spell-descriptor)
				      &key create)
  (let ((compounds (get-instances-by-value
		    'spell-compound-descriptor
		    'name (spell-descriptor-name primary))))
    (if-bind found (find-if (lambda (s) (eq (alternate-object s) secondary))
			    compounds)
      (values found t)
      (if create
	  (values
	   (make-instance 'spell-compound-descriptor
			  :name (spell-descriptor-name primary)
			  :kind :alternative
			  :alternative secondary)
	   t)
	  (values nil nil)))))