[Initial database connection functionality
clinton@unknownlamer.org**20080425042410
 Fills database with enough basic d20 system information to support spells
] hunk ./src/initialize-database.lisp 1
+(in-package :org.unknownlamer.dnd-tools)
+
+(defvar *character-classes* '(barbarian bard cleric druid fighter
+			      monk paladin ranger rogue sorceror wizard))
+
+(defvar *caster-classes*
+  '((bard 1 2 4 7 10 13 16)
+    (cleric 1 1 3 5 7 9 11 13 15 17)
+    (druid 1 1 3 5 7 9 11 13 15 17)
+    (paladin nil 4 8 11 14)
+    (ranger nil 4 8 11 14)
+    (sorceror 1 1 4 6 8 10 12 14 16 18)
+    (wizard 1 1 3 5 7 9 11 13 15 17))
+  "Caster class keys and spell levels progression (nil means the
+  caster does not get spells of the level corresponding to that
+  position)")
+
+(defvar *cleric-domains* '(air animal chaos death destruction earth
+			   evil fire good healing knowledge law luck
+			   magic plant protection strength sun travel
+			   trickery war water))
+
+(defvar *spell-schools* '((abjuration)
+			  (conjuration calling creation healing summoning
+			               teleporation)
+			  (divination scrying)
+			  (enchantment charm compulsion)
+			  (evocation)
+			  (illusion figment glamer pattern phantasm shadow)
+			  (necromancy)
+			  (transmutation)
+			  (universal))
+  "(school . (subschools ...)")
+
+(defvar *spell-descriptors* '(acid air darkness death earth electricity fear
+			      fire force language-dependent light mind-affecting
+			      sonic water))
+
+(defvar *alignments* '(good evil law chaos neutral))
+
+(defun initialize-player-classes ()
+  (let ((character-classes *character-classes*))
+      (mapc (lambda (class-name)
+	      (let ((player-class (make-instance 'player-class
+						 :name class-name)))
+		(setf (player-levels player-class)
+		      (make-pset
+		       :items (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
+	 (let* ((info (assoc 'cleric *caster-classes*))
+		(class (get-instance-by-value
+			'player-class 'name (car info)))
+		(levels (player-levels class)))
+	   (cons class
+		 (mapcar (lambda (level)
+			   (find-item level levels :key #'player-level))
+			 (cdr info))))))
+    (mapcar (lambda (domain)
+	      (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 :domain 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)
+		  (let* ((class (get-instance-by-value
+				 'player-class 'name (car caster-info)))
+			 (levels (player-levels class)))
+		    (cons
+		     class
+		     (mapcar (lambda (level)
+			       (if level
+				   (find-item level levels :key #'player-level)))
+			     (cdr caster-info)))))
+		*caster-classes*)))
+
+(defun initialize-spell-schools ()
+  (mapc (lambda (school-list)
+	  (let ((school-class (make-instance 'spell-school
+					     :school (car school-list))))
+	    (setf (spell-school-subschools school-class)
+		  (if (cdr school-list)
+		      (make-pset
+		       :items (mapcar (lambda (subschool)
+					(make-instance 'spell-subschool
+						       :school school-class
+						       :subschool subschool))
+				      (cdr school-list)))))))
+	*spell-schools*))
+
+
+
+(defun initialize-database ()
+  (connect)
+  (mapc (lambda (initializer)
+	  (ensure-transaction (:store-controller dnd-db::*db-store*)
+	    (funcall initializer)))
+	(list
+	 #'initialize-player-classes
+	 #'initialize-cleric-domains
+	 #'initialize-spell-levels
+	 #'initialize-spell-schools)))
+
+(defun %destroy-database ()
+  (disconnect)
+  (cl-fad:delete-directory-and-files "/home/clinton/misc/bdb/dnd")
+  (ensure-directories-exist "/home/clinton/misc/bdb/dnd/foo"))
+
+
+