After the horrible mess that was the scraper script, I decided to make something a bit cleaner.

It’s a nice little game that teaches you about the different months.

It works pretty well, but I think the code needs some work:

(defpackage :month-game
  (:use :cl :hunchentoot :cl-who))

(in-package :month-game)

(push (create-regex-dispatcher "^/lisp/months$" 'months-page) *dispatch-table*)
(push (create-regex-dispatcher "^/months$" 'months-page) *dispatch-table*)

(defvar *months* '((1 "January")
                   (2 "February")
                   (3 "March")
                   (4 "April")
                   (5 "May")
                   (6 "June")
                   (7 "July")
                   (8 "August")
                   (9 "September")
                   (10 "October")
                   (11 "November")
                   (12 "December")))

(defun month-name (month)
  "Take a month and return it's name"
  (cadr month))

(defun month-number (month)
  "Take a month and return it's number"
  (car month))

(defun random-item (list)
  "Take a list and return one item from it at random"
  (nth (random (length list)) list))

(defmacro create-question-template (&body body)
  "Macro to make adding question templates easier"
  `(lambda () ,@body))

(defvar *question-templates*
     "Take a month, ask them which number it is."
     (let* ((month (assoc (+ 1 (random 12)) *months*))
            (question (format nil "What is the ~:r month called?" (month-number month)))
            (correct-response (format nil "That's correct!~%"))
            (wrong-response (format nil "Wrong, the ~:r month is ~A~%" (month-number month) (month-name month)))
            (test-fun (lambda (answer)
                        (if (string-equal answer
                                          (month-name month))
       (list question test-fun correct-response wrong-response)))

    "Give a month and take it's number."
    (let* ((month (assoc (+ 1 (random 12)) *months*))
           (question (format nil "Which number month is ~A?" (month-name month)))
           (correct-response (format nil "That's correct!~%"))
           (wrong-response (format nil "No, that's wrong.. ~A is the ~:r month.~%" (month-name month) (month-number month)))
           (test-fun (lambda (answer)
                       (if (eql (parse-integer answer :junk-allowed t)
                                (month-number month))
      (list question test-fun correct-response wrong-response)))

    "Which month comes next?"
    (let* ((random-number (+ 1 (random 11)))
           (month (assoc random-number *months*))
           (next-month (assoc (+ 1 random-number) *months*))
           (question (format nil "Which month comes after ~A?" (month-name month)))
           (correct-response (format nil "That's correct!~%"))
           (wrong-response (format nil "No, that's wrong.. ~A comes after ~A.~%" (month-name month) (month-name next-month)))
           (test-fun (lambda (answer)
                       (if (string-equal answer (month-name next-month))
      (list question test-fun correct-response wrong-response)))

    "Which month goes before?"
    (let* ((random-number (+ 2 (random 11)))
           (month (assoc random-number *months*))
           (last-month (assoc (- random-number 1) *months*))
           (question (format nil "Which month goes before ~A?" (month-name month)))
           (correct-response (format nil "That's correct!~%"))
           (wrong-response (format nil "No, that's wrong.. ~A goes before ~A.~%" (month-name last-month) (month-name month)))
           (test-fun (lambda (answer)
                       (if (string-equal answer (month-name last-month))
      (list question test-fun correct-response wrong-response)))))

(defun random-question ()
  "Return a question at random"
  (funcall (random-item *question-templates*)))

(defun create-questions (number-of-questions)
  "Return a list of questions"
  (loop for y from 1 to number-of-questions
       collect (random-question)))

(defun mark-answer (question answer)
  "Take a question and answer and return t if correct."
  (if answer
      (let ((result (funcall (cadr question) answer)))
        (if result
            (values result (caddr question))
            (values result (cadddr question))))
      (values nil (cadddr question))))

(defun right-answers (answers)
  "Return a count of how many answers were right."
  (count nil answers :key 'not))

(defun ad-banner ()
  "<script type='text/javascript'><!--
google_ad_client = 'pub-6037667691060767';
/* Lisp days - Try 1 */
google_ad_slot = '3672844700';
google_ad_width = 468;
google_ad_height = 15;
<script type='text/javascript'

(defun html-prompt (question)
  "Ask the user a question through a HTML form."
  (with-html-output-to-string (*standard-output* nil :indent t)
    (htm (:p (fmt "~A" (car question)))
         (:form :id "form" :action "/months" :method "post"
                (:input :id "guess" :name "guess" :size "30" :style "text-align:center" :autocomplete "off")
                (:input :type "submit" :name "submit" :value "Answer")))))

(defun snazzy-prompt (question number)
  (with-html-output-to-string (*standard-output* nil :indent t)
    (htm (:div :id "prompt"
               (:h2 (fmt "Question ~A" number))
               (fmt "~A" (html-prompt question))))))

(defun show-score (answers questions)
  "Display a nice tally of the game's score"
  (with-html-output-to-string (*standard-output* nil :indent t)
    (when answers
      (loop for n from (- (length answers) 1) downto 0
         do (if (nth n answers)
                (htm (:b "*"))
                (htm (:b ".")))))
    (when (and questions
               (> (length questions) (length answers)))
      (loop for n from (+ 1 (length answers)) to (length questions)
         do (htm (:b "-" ))))
    (when (and (not questions)
               (not answers))

(defun months-page ()
  "Function to create the month game page that's displayed."
  (let ((questions (session-value "questions"))
        (current-question (session-value "current-question"))
        (guess (post-parameter "guess"))
        (answers (session-value "answers")))
    (with-html-output-to-string (*standard-output* nil :indent t)
        (:title "Months of the Year Learning Game")
        (:link :type "text/css"
               :rel "stylesheet"
               :href "/lisp/template.css")
        (:script :type "text/javascript"
                 :src "/lisp/include.js"))
       (:body :onload "setFocus();"
               (:p (fmt "~A" (ad-banner)))
               (:h1 "Months of the Year Learning Game")
               (if (not questions)      ; New Game's starting
                     (htm (:p (:b "Welcome to the Month Learning Game!"))
                          (:p (:i "Try your best to answer 10 questions about the different Months"))
                     (setf (session-value :current-question) 0)
                     (setf (session-value :answers) nil)
                     (setf (session-value :questions) (create-questions 10))
                     (fmt "~A" (snazzy-prompt (nth (session-value :current-question) (session-value :questions)) 1)))
                   (if (not (< 0 (length guess)))
                       (htm (:p (:b "Please Answer!"))
                            (fmt "~A" (snazzy-prompt (nth current-question questions) (+ 1 current-question))))
                       (multiple-value-bind (result output) ; Game's in progress
                           (mark-answer (nth current-question questions) guess)
                         (push result (session-value :answers))
                         (push result answers)
                         (htm (:p (:i (fmt "'~A ~A'" (car (nth current-question questions)) guess)))
                              (:p (fmt "~A"  output)))
                         (incf current-question)
                         (incf (session-value :current-question))
                         (if (eql current-question (length questions)) ; Game's just finished
                               (htm (:p (:b (fmt "** You scored ~A out of ~A **"
                                                 (right-answers answers)
                                                 (length questions))))
                                    (:p (:a :href "/months" "Play again?")))
                               (delete-session-value :questions)
                               (delete-session-value :current-question)
                               (delete-session-value :answers))
                                        ;Game's still going, ask another question!
                             (fmt "~A" (snazzy-prompt (nth current-question questions) (+ 1 current-question)))))))
               (fmt "~A" (show-score (session-value :answers)
                                     (session-value :questions)))))))))
  • It’s reasonably flexible already, but I want to be able to make separate quizzes without rewriting stuff.
  • I’m also not sure about how I wrote the game logic inside the months-page function. It’s messy, but I don’t see how else to do it.
  • I don’t like how creating the question templates looks so ugly.

I’m a bit stuck with how to improve the code now, could anyone give me any pointers?

Cheers, Dave.