;; initialize-database.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.db.initialize)

(defparameter *derived-indices*
  '((player-level player-level->player-class player-level->player-class-indexer)
    (spell-level spell-level->caster-class spell-level->caster-class-indexer)
    (spell-level spell-level->player-class spell-level->player-class-indexer)))

(defun initialize-derived-indices ()
  (mapcar (curry #'apply  #'add-class-derived-index)
	  *derived-indices*))

(defun destroy-derived-indices ()
  (mapcar (curry #'apply #'remove-class-derived-index)
	  (mapcar (lambda (di) (list (first di) (second di)))
		  *derived-indices*)))

(defun initialize-player-classes ()
  (let ((character-classes *character-classes*))
      (mapc (lambda (class-name)
	      (let ((player-class (make-instance 'player-class
						 :name class-name)))
		(map-range
		 (lambda (level)
		   (make-instance 'player-level :level level
				  :level-class player-class))
		 1 20)))
	    character-classes)))

(defun initialize-cleric-domains ()
  (let ((cleric-progression
	 (cons (find-player-class 'cleric)
	       (mapcar (lambda (level)
			 (find-player-level 'cleric level))
		       (cdr (assoc 'cleric *caster-classes*))))))
    (mapcar (lambda (domain)
	     (setf (spell-domain-levels domain)
		   (make-pset
		    :items
		    (map-range
		     (lambda (domain-level)
		       (if-bind caster-level
				(nth domain-level (cdr cleric-progression))
				(make-instance 'spell-domain-level
					       :spell-level domain-level
					       :domain domain
					       :caster-level caster-level)))
		     1 9))))
	    (mapcar (lambda (domain)
		      (make-instance 'spell-domain :name domain))
		    *cleric-domains*))))


(defun initialize-spell-levels ()
  (mapc (lambda (caster-progression)
	  (destructuring-bind (caster-class &rest progression)
	      caster-progression
	    (declare (ignore caster-class))
	    (map-range (lambda (spell-level)
			 (if-bind caster-level (nth spell-level progression)
			     (make-instance 'spell-level
					    :spell-level spell-level
					    :caster-level caster-level)))
		       0 9)))
	(mapcar (lambda (caster-info)
		  (cons
		   (find-player-class (car caster-info))
		   (mapcar (lambda (level)
			     (if level
				 (find-player-level (car caster-info)
						    level)))
			   (cdr caster-info))))
		*caster-classes*)))

(defun initialize-spell-schools ()
  (mapc (lambda (school-list)
	  (let ((school-class (make-instance 'spell-school
					     :name (car school-list))))
	    (mapc (lambda (subschool)
		    (make-instance 'spell-subschool
				   :school school-class
				   :name subschool))
		  (cdr school-list))))
	*spell-schools*))

(defun initialize-spell-components ()
  (mapc (lambda (component)
	  (make-instance 'spell-component
			 :name (first component) :abbreviation (second component)))
	*spell-components*))

(defun initialize-spell-descriptors ()
  (mapc (lambda (descriptor)
	  (make-instance 'spell-descriptor :name descriptor))
	*spell-descriptors*))

(defun initialize-database ()
  (connect)
  (mapc (lambda (initializer)
	  (ensure-transaction (:store-controller dnd-db::*db-store*)
	    (funcall initializer)))
	(list
	 #'initialize-derived-indices
	 #'initialize-player-classes
	 #'initialize-cleric-domains
	 #'initialize-spell-levels
	 #'initialize-spell-schools
	 #'initialize-spell-components
	 #'initialize-spell-descriptors)))

(defun %destroy-database ()
  (destroy-derived-indices)
  (mapcar (compose #'drop-instances #'get-instances-by-class)
	  '(player-class player-level
	    spell-level spell-domain-level
	    spell-domain spell-school spell-subschool
	    spell-descriptor spell-component
	    spell
	    spell-compound-descriptor spell-compound-subschool)))