[Better compound subschool and descriptor support
clinton@unknownlamer.org**20080428175944
 * Subclass from appropriate related class
 * Only once instance of an alternative will exist in the database
 * New query functions to find alternative/compound schools/descriptors
 * Query functions have a :create argument to create the compound
   object when needed
] {
hunk ./src/packages.lisp 30
-	   :spell-alternative-descriptors
+	   :spell-compound-descriptor
hunk ./src/packages.lisp 41
-	   :find-spell-descriptor))
+	   :find-spell-descriptor
+
+	   :find-compound-subschool
+	   :find-alternate-descriptor))
hunk ./src/queries.lisp 84
+
+(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)))))
hunk ./src/spells.lisp 46
-(defclass spell-alternative-descriptors ()
-  ((descriptor-1 :initarg :descriptor-1 :accessor descriptor-1 :index t)
-   (descriptor-2 :initarg :descriptor-2 :accessor descriptor-2 :index t))
-  (:metaclass persistent-metaclass)
-  (:documentation "FOO or BAR descriptor; spell may be qualified by
-  either descriptor depending upon context"))
-
hunk ./src/spells.lisp 52
-(defclass spell-compound-subschool ()
-  ((schools :initarg :schools :accessor spell-schools)
-   (kind :initarg :kind :accessor compound-school-kind
-	 :type (member :alternative :additional)))
-  (:metaclass persistent-metaclass))
-
-(defmethod insert-item (spell (scs spell-compound-subschool))
-  "Add spell to each subschool"
-  (map-pset (curry #'insert-item spell)
-	    (spell-schools scs)))
-
-(defmethod remove-item (spell (scs spell-compound-subschool))
-  "Remove spell from each subschool"
-  (map-pset (curry #'remove-item spell)
-	    (spell-schools scs)))
-
-(defmethod alternative-subschoolsp ((s spell-compound-subschool))
-  (eq (compound-school-kind s) :alternative))
-
-(defmethod additional-subschoolsp ((s spell-compound-subschool))
-  (eq (compound-school-kind s) :additional))
-
hunk ./src/spells.lisp 97
+
+(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 insert-item :around (spell (self spell-compound-subschool))
+  "Add spell to each subschool"
+  (call-next-method)
+  (insert-item spell (alternate-object self)))
+
+(defmethod remove-item :around (spell (self spell-compound-subschool))
+  "Remove spell from each subschool"
+  (call-next-method)
+  (remove-item spell (alternate-object self)))
+
+(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))
+
hunk ./src/srd-import.lisp 360
-		       (cons (make-instance
-			      'spell-alternative-descriptors
-			      :descriptor-1 (find-spell-descriptor (second d))
-			      :descriptor-2 (find-spell-descriptor (third d))))))
+		       (cons (find-alternate-descriptor
+			      (find-spell-descriptor (second d))
+			      (find-spell-descriptor (third d))
+			      :create t))))
hunk ./src/srd-import.lisp 389
-				 (make-instance
-				  'spell-compound-subschool
-				  :schools (make-pset
-					    :items (list spell-school
-							 (cdr alt-spell-school)))
-				  :kind (car alt-spell-school))
+				 (find-compound-subschool
+				  spell-school (cdr alt-spell-school)
+				  (car alt-spell-school) :create t)
}