[Initial parsed-spell to spell database object converter
clinton@unknownlamer.org**20080427035301
 Mostly works with the following caveats:
 * Alternative subschools and descriptors are not supported
 * See Text notes are not recorded
] {
hunk ./src/packages.lisp 48
-	:org.unknownlamer.dnd-tools.db.symbols)
+	:org.unknownlamer.dnd-tools.db.symbols
+	:org.unknownlamer.dnd-tools)
hunk ./src/packages.lisp 51
-  (:import-from :arnesi :compose :if-bind :rcurry)
+  (:import-from :arnesi :compose :if-bind :rcurry :with-unique-names)
+  (:import-from :elephant :make-pset)
hunk ./src/srd-import.lisp 275
+(defmacro assoc-bind ((&rest binds) alist (&rest assoc-options) &body body)
+  (with-unique-names (alist-var)
+    (flet ((assoc-call (key)
+	     `(assoc ,key ,alist-var ,@assoc-options)))
+      `(let ((,alist-var ,alist))
+	 (let ,(mapcar (lambda (bind)
+			 `(,(first bind) ,(assoc-call (second bind))))
+		       binds)
+	   ,@body)))))
+
+(defun parsed-spell->spell-object (parsed-spell)
+  (assoc-bind ((school :school)
+	       (levels :level)
+	       (components :components)
+	       (casting-time :casting-time)
+	       (range :range)
+	       (effect :effect)
+	       (duration :duration)
+	       (saving-throw :saving-throw)
+	       (resistance :spell-resistance)
+	       (name :name)
+	       (description :description))
+      parsed-spell ()
+    (let ((spell-school
+	   (find-spell-school (spell-table-ref :school (cdr school))
+			      (spell-table-ref :subschool (cdr school))))
+	  (spell-descriptors (mapcar #'find-spell-descriptor
+				     (spell-table-ref :modifiers (cdr school))))
+	  (spell-alignment (spell-table-ref :alignment (cdr school)))
+	  (spell-levels (mapcar (lambda (l) (find-spell-level (car l) (cdr l)))
+				(spell-table-ref :classes (cdr levels))))
+	  (spell-domains (mapcar (lambda (l) (find-spell-domain-level (car l) (cdr l)))
+				 (spell-table-ref :domains (cdr levels))))
+	  (spell-components
+	   (mapcar (lambda (c) (cond ((symbolp c)
+				 (find-spell-component c))
+				((and (consp c) (eq (car c) :divine-alternative))
+				 (find-spell-component (second c)))
+				(t (error "Unknown spell component: ~A" c))))
+		   (cdr components)))
+	  (divine-alternatives (mapcar (lambda (c)
+					 (cons (find-spell-component (second c))
+					       (find-spell-component (third c))))
+				       (remove-if-not
+					(lambda (c)
+					  (and (consp c)
+					       (eq (car c) :divine-alternative)))
+					(cdr components)))))
+      (make-instance 'spell
+		     :name (cdr name)
+		     :levels (make-pset :items (append spell-levels spell-domains))
+		     :school spell-school
+		     :alignment (or spell-alignment 'neutral)
+		     :descriptors (if spell-descriptors
+				      (make-pset :items spell-descriptors))
+		     :components (make-pset :items spell-components)
+		     :divine-alternatives (if divine-alternatives
+					      (make-pset :items divine-alternatives))
+		     :casting-time (cdr casting-time)
+		     :range (cdr range)
+		     :effect (cdr effect)
+		     :duration (cdr duration)
+		     :saving-throw (cdr saving-throw)
+		     :resistance (cdr resistance)
+		     :description (cdr description)))))
+
}