{ move ./src/queries.lisp ./src/spell-queries.lisp addfile ./src/queries.lisp hunk ./src/spell-queries.lisp 1 -;; queries.lisp --- Part of srd-tools - -;; Copyright (C) 2008 Clinton Ebadi - -;; Author: Clinton Ebadi - -;; 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 . - - -(in-package :org.unknownlamer.dnd-tools) - -;;; Methods for finding various core database instances. These should all -;;; return two values like get-instance-by-value: (object found?) - -;;; Anything that takes a symbol as an argument and then looks up a -;;; class from that to use as an argument to a recursive call needs an -;;; (eql nil) case for the argument to prevent infinite -;;; recursion. Damn nil being a symbol and a cons! - -(defgeneric find-player-class (name)) -(defgeneric find-player-level (player-class level)) - -(defmethod find-player-class ((name symbol)) - (get-instance-by-value 'player-class 'name name)) - -(defmethod find-player-level ((player-class-name symbol) level) - (find-player-level (find-player-class player-class-name) level)) - -(defmethod find-player-level ((player-class player-class) (level integer)) - (get-instance-by-value 'player-level - 'player-level->player-class - (cons player-class level))) - -(defmethod find-player-level ((player-class (eql nil)) level) - (values nil nil)) - -(defgeneric find-spell-component (name)) -(defgeneric find-spell-school (school subschool)) -(defgeneric find-spell-domain (name)) -(defgeneric find-spell-level (player-class spell-level)) -(defgeneric find-spell-domain-level (domain level)) -(defgeneric find-spell-descriptor (name)) - -(defmethod find-spell-component ((name symbol)) - (get-instance-by-value 'spell-component 'name name)) - -(defmethod find-spell-school ((school-name symbol) (subschool (eql nil))) - (get-instance-by-value 'spell-school 'name school-name)) - -(defmethod find-spell-school ((school-name symbol) subschool) - (find-spell-school (find-spell-school school-name nil) subschool)) - -(defmethod find-spell-school ((school spell-school) (subschool symbol)) - (if-bind subschool (find subschool (spell-school-subschools school) - :key #'spell-subschool-name) - (values subschool t) - (values nil nil))) - -(defmethod find-spell-school ((school (eql nil)) subschool) - (values nil nil)) - -(defmethod find-spell-domain ((name symbol)) - (get-instance-by-value 'spell-domain 'name name)) - -(defmethod find-spell-level ((player-class-name symbol) spell-level) - (find-spell-level (find-player-class player-class-name) spell-level)) - -(defmethod find-spell-level ((player-class player-class) (spell-level integer)) - ;; Inefficient; this needs a dedicated index or similar - (get-instance-by-value 'spell-level 'spell-level->caster-class - (cons player-class spell-level))) - -(defmethod find-spell-level ((player-class (eql nil)) spell-level) - (values nil nil)) - -(defmethod find-spell-domain-level ((domain-name symbol) level) - (find-spell-domain-level (find-spell-domain domain-name) level)) - -(defmethod find-spell-domain-level ((domain spell-domain) (level integer)) - (if-bind level (find-item level (spell-domain-levels domain) - :key #'spell-level) - (values level t) - (values nil nil))) - -(defmethod find-spell-domain-level ((domain (eql nil)) level) - (values nil nil)) hunk ./src/spell-queries.lisp 2 -(defmethod find-spell-descriptor ((name symbol)) - (get-instance-by-value 'spell-descriptor 'name name)) - -;;; Interface for spell class - -(defgeneric find-spell-by-name (spell-name)) -(defgeneric find-spells-by-alignment (alignment)) -(defgeneric find-spells-by-school (school) - (:documentation "Find spells within a given # or - #. If given a SCHOOL all spells from all subschools - are returned.")) -(defgeneric find-spells-by-caster-class (class level) - (:documentation "Find spells usable by CLASS. If LEVEL is nil then - find all spells for caster CLASS. LEVEL is the spell level not the - caster level.")) -(defgeneric find-spells-by-spell-level (level) - (:documentation "Find spells at LEVEL. If LEVEL is an integer fetch - all spells for all classes of spell level LEVEL, if LEVEL is a - # fetch all spells for that level/class.")) - -(defmethod find-spell-by-name ((spell-name string)) - (get-instance-by-value 'spell 'name spell-name)) - -(defmethod find-spells-by-alignment ((alignment (eql nil))) - (values nil nil)) - -(defmethod find-spells-by-alignment ((alignment symbol)) - (get-instances-by-value 'spell 'alignment alignment)) - -(defmethod find-spells-by-school ((school spell-school)) - (if-bind spells - (append (get-instances-by-value 'spell 'school school) - (apply #'append - (mapcar #'find-spells-by-school - (spell-school-subschools school)))) - (values spells t) - (values nil nil))) - -(defmethod find-spells-by-school ((school spell-subschool)) - (if-bind spells (get-instances-by-value 'spell 'school school) - (values spells t) - (values nil nil))) - -(defmethod find-spells-by-caster-class ((class symbol) level) - (find-spells-by-caster-class (find-player-class class) level)) - -(defmethod find-spells-by-caster-class ((class player-class) (level integer)) - (find-spells-by-spell-level (find-spell-level class level))) - -(defmethod find-spells-by-caster-class ((class player-class) (level (eql nil))) - (apply #'append - (mapcar #'find-spells-by-spell-level - (get-instances-by-value 'spell-level - 'spell-level->player-class - class)))) - -(defmethod find-spells-by-caster-class ((class (eql nil)) level) - (values nil nil)) - -(defmethod find-spells-by-spell-level ((level spell-level)) - (mapcar #'spell - (get-instances-by-value 'spell-level<->spell 'level level))) - -(defmethod find-spells-by-spell-level ((level integer)) - (apply #'append - (mapcar #'find-spells-by-spell-level - (get-instances-by-value 'spell-level 'level level)))) - - -;;; Compound classes - -(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))))) rmfile ./src/spell-queries.lisp }