```;;;;;;;;;;;;;;
;
;  -------
;  A Completely Automated Public Turing test
;    to tell Computers and Humans Apart
;    generator.
;  Generates simple written arithmatic problems.
;
;  AUTHOR: Joseph Abrahamson
;  YEAR:   2006
;
;;;;;;;;;;;;;;

(:use :cl)

(defconstant +numbermax+ 10)

(defvar *query-strings* '((* "what is ~r times ~r?"
(gennumber gennumber))
(* "what is the product of ~r and ~r?"
(gennumber gennumber))
(* "what is the area of a ~r by ~r rectangle?"
(gennumber gennumber))
(* "If you have ~r card~:p in a deck, then give the deck away,
how many cards do you have?~*"
(gennumber 0))
(+ "what is ~r plus ~r?"
(gennumber gennumber))
(+ "what is the sum of ~r, ~r, and ~r?"
(gennumber gennumber gennumber))
(+ "if you have ~r apricot~:p and buy ~r more, how many do you have?"
(gennumber gennumber))
(- "what is ~r less ~r?"
(gennumber gennumber))
(- "what is the difference between ~r and ~r?"
(gennumber gennumber))
(- "if you have ~r dollar~:p but owe ~r, you effectively have how many?"
(gennumber gennumber))
(/ "what is ~r over ~r?"
(gennumber gennumber))
(/ "what is the quotient of ~r and ~r"
(gennumber gennumber))
(/ "if you could split ~r watch~:*~[es~;~:;es~] into ~r equal
group~:p, how many are in each group?"
(gennumber gennumber))))
; Etc...

(defun gennumber (&optional (max +numbermax+) (min 0))
(+ (random (- max min)) min))

(defclass query ()
((text
:initarg :text
:initform (error "Query must have text.")
:documentation "FORMAT string to convert to captcha query.")
(string-types
:initarg :string-types
:initform (error "Query must have FORMAT args.")
:documentation "Arguments of generator functions which will
))

(defclass query+ (query) ())
(defclass query- (query) ())
(defclass query* (query) ())
(defclass query/ (query) ())

;; DATABASE AND SUCH

(defun generate-query-database (&optional (data *query-strings*))
(loop
for query in data
collect (let ((type   (first query))
(string (second query))
(args   (third query)))
(make-instance (intern (concatenate 'string
"QUERY"
(symbol-name type)))
:text string
:string-types args))))

(defvar *db* (generate-query-database))

;; PERFORM QUERY
;
;  Returns a string to print and a string to be compared against as the answer.
(defgeneric perform (q &optional string-args)
(:documentation "PERFORM analyzes passed query and generates a
questionform and its

(defmacro once-only ((&rest names) &body body)
;; Peter Seibel's Implementation of ONCE-ONLY
;; from PCL.
(let ((gensyms (loop for n in names collect (gensym))))
`(let (,@(loop for g in gensyms collect `(,g (gensym))))
`(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n)))
,(let (,@(loop for n in names for g in gensyms collect `(,n ,g)))
,@body)))))

(defmacro perform-values (q fn string-args)
(once-only (q fn string-args)
`(values (apply #'format (append (list nil (slot-value ,q 'text))
,string-args))
(format nil "~a" (reduce ,fn ,string-args)))))

(defmethod perform :around ((q query) &optional string-args)
(call-next-method q (or string-args
(mapcar (lambda (x)
(typecase x
(list (apply (car x) (cdr x)))
(symbol (if (fboundp x)
(funcall x)
(error "Symbol ~A is not bound to function. Must be removed
from args list of query ~a" x q)))
(t x)))
(slot-value q 'string-types)))))

(defmethod perform ((q query/) &optional (string-args ()))
; Avoid division by 0.
(perform-values q #'/ (substitute-if (gennumber +numbermax+ 1)
#'zerop  string-args)))

(defmethod perform ((q query*) &optional (string-args ()))
(perform-values q #'* string-args))

(defmethod perform ((q query+) &optional (string-args ()))
(perform-values q #'+ string-args))

(defmethod perform ((q query-) &optional (string-args ()))
(perform-values q #'- (sort (copy-list string-args) #'>)))