[Improvements to spell school scanner and basic saving throw parser
clinton@unknownlamer.org**20080417173952] {
hunk ./src/srd-import.lisp 37
-(defparameter *spell-school-scanner*
+(let ((school-modifiers-pattern
+       '(:sequence
+	 (:greedy-repetition 1 nil (:char-class
+				    #\-
+				    :word-char-class))
+	 (:alternation :word-boundary ", "))))
+  (defparameter *spell-school-scanner*
+    (cl-ppcre:create-scanner
+     `(:sequence
+       :start-anchor
+       (:register (:greedy-repetition 1 nil :word-char-class))
+       (:alternation
+	(:sequence #\space
+		   #\(
+		   (:register (:greedy-repetition 1 nil :word-char-class))
+		   #\))
+	:end-anchor
+	"")
+       (:alternation
+	(:sequence #\space
+		   #\[
+		   (:alternation
+		    (:register
+		     (:greedy-repetition 1 nil
+					 ,school-modifiers-pattern))
+		    (:sequence (:register "see text")
+			       (:alternation
+				""
+				(:sequence
+				 #\space
+				 (:register (:greedy-repetition 0 nil :everything))))))
+		   #\])
+	:end-anchor))))
+    
+  (defparameter *spell-school-modifiers-scanner*
+    (cl-ppcre:create-scanner school-modifiers-pattern)))
+
+
+(defparameter *spell-resistance-scanner*
hunk ./src/srd-import.lisp 79
-     (:register (:greedy-repetition 1 nil :word-char-class))
+     (:register (:greedy-repetition 2 3 :word-char-class))
hunk ./src/srd-import.lisp 85
-      :end-anchor
-      "")
-     (:alternation
-      (:sequence #\space
-       #\[
-       (:register (:greedy-repetition 1 nil (:char-class
-					     #\-
-					     :word-char-class)))
-       #\])
hunk ./src/srd-import.lisp 87
-(defparameter *spell-resistance-scanner*
+(defparameter *spell-saving-throw-scanner*
hunk ./src/srd-import.lisp 91
-     (:register (:greedy-repetition 2 3 :word-char-class))
+     (:register (:greedy-repetition 1 nil :word-char-class))
+     (:alternation
+      (:sequence #\space (:register (:greedy-repetition 1 nil :word-char-class)))
+      :end-anchor
+      "")
hunk ./src/srd-import.lisp 160
-  (cl-ppcre:register-groups-bind (school subschool type)
+  (cl-ppcre:register-groups-bind (school subschool type see-text? where)
hunk ./src/srd-import.lisp 162
-    (mapcar (lambda (string) (if string (intern (string-upcase string))))
-	    (list school subschool type))))
+    (destructuring-bind (school subschool (&rest modifiers) (&rest see-text))
+	(mapcar (lambda (component)
+		  (let ((local-intern (compose (rcurry #'intern
+						       :org.unknownlamer.dnd-tools.srd-import)
+				       #'string-upcase)))
+		    (typecase component
+		      (string (funcall local-intern component))
+		      (cons (mapcar
+			     local-intern component)))))
+		(list school subschool
+		      (ppcre:all-matches-as-strings
+		       *spell-school-modifiers-scanner* type)
+		      (list see-text? where)))
+      `((:school . ,school)
+	,@(if subschool `((:subschool . subschool)))
+	,@(cond (modifiers
+		 `(,@(let ((alignments '(good chaotic lawful evil)))
+			  (list
+			   (if-bind alignment
+			       (remove-if-not (lambda (item) (member item alignments))
+					      modifiers)
+			     `(:alignment . ,(car alignment)))
+			   (if-bind other
+			       (remove-if (lambda (item) (member item alignments))
+					  modifiers)
+			     `(:modifiers . ,other)))))))
+	,@(if (car see-text) `((:see-text . ,(or (cadr see-text) t))))))))
+
hunk ./src/srd-import.lisp 197
+(defun parse-spell-saving-throw (saving-throw-string)
+  (cl-ppcre:register-groups-bind (saving-throw modifier target/type)
+      (*spell-saving-throw-scanner* saving-throw-string)
+    (mapcar (lambda (string) (if string (intern (string-upcase string))))
+	    (list saving-throw modifier target/type))))
}