Here's my take at it, though it's obviously the work of a beginner.
CL-USER> (captcha:generate-captcha) "what is six plus four?" "10" CL-USER> (captcha:generate-captcha) "what is the difference between five and four?" "1" CL-USER> (loop for x from 1 to 1000 do (captcha:generate-captcha)) NIL
~~~~~~~~~~
;;;;;;;;;;;;;; ; ; CAPTCHA ; ------- ; A Completely Automated Public Turing test ; to tell Computers and Humans Apart ; generator. ; Generates simple written arithmatic problems. ; ; -- DEPENDS on: ; "Iterate":http://common-lisp.net/project/iterate/ ; ; ; AUTHOR: Joseph Abrahamson ; YEAR: 2006 ; ;;;;;;;;;;;;;;
(defpackage :captcha (:use :cl) (:export #:generate-captcha))
(in-package :captcha)
(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 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 produce values for captcha.") ))
(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 cooresponding answerform."))
(defmacro perform-values (q fn string-args) (let ((s-a string-args)) `(values (apply #'format (append (list nil (slot-value ,q 'text)) ,s-a)) (format nil "~a" (reduce ,fn ,s-a)))))
(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) #'>)))
;; GENERATE-CAPTCHA (defun generate-captcha (&key type (db *db*)) "Produces a random CAPTCHA from DB. If TYPE is supplied, only CAPTCHAs of that type may be returned." (let ((db (remove-if (if type (lambda (x) (not (eq (type-of x) type))) (constantly nil)) db))) (perform (elt db (random (length db))))))
~~~~~~~~~~
Cheers.
-- ~ja.