;;deffunctions

(deffunction ask-question (?question $?allowed-values)
   (printout t ?question)
   (bind ?answer (read))
   (if (lexemep ?answer) 
       then (bind ?answer (lowcase ?answer)))
   (while (not (member ?answer ?allowed-values)) do
      (printout t ?question)
      (bind ?answer (read))
      (if (lexemep ?answer) 
          then (bind ?answer (lowcase ?answer))))
   ?answer)

(deffunction yes-or-no-p (?question)
   (bind ?response (ask-question ?question yes no y n))
   (if (or (eq ?response yes) (eq ?response y))
       then TRUE 
       else FALSE))

;;;waltz in dm

(defrule dm-waltz ""
   (declare (salience 10))
   (genre waltz)
   =>
   (assert (melody "D FA FA | A FA FA | A CE"))
   (assert (keye dm)))

;;;query

(defrule determine-engine-state ""
   (not (genre ?))
   (not (melody ?))
   =>
   (if (yes-or-no-p "Will the genre be waltz (yes/no)? ") 
       then (assert (genre waltz))
	   else (assert (genre classical))))

(defrule determine-rotation-state ""
   (genre classical)
   (not (melody ?))   
   =>
   (if (yes-or-no-p "Will the key be Em (yes/no)? ")
       then
       (assert (keye em))
	   (assert (melody "E G A B | E A G D | E"))
       else      
       (assert (keye f))
	   (assert (melody "F A B C | E D B F | G"))))

;;;startup

(defrule system-banner ""
  (declare (salience 10))
  =>
  (printout t crlf crlf)
  (printout t "Waltz/classical melody")
  (printout t crlf crlf))

(defrule print-melody ""
  (declare (salience 10))
  (melody ?item)
  =>
  (printout t crlf crlf)
  (printout t "Suggested melody:")
  (printout t crlf crlf)
  (format t " %s%n%n%n" ?item))