November 26th, 2008
Month learning game
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*
(list
(create-question-template
"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))
t))))
(list question test-fun correct-response wrong-response)))
(create-question-template
"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))
t))))
(list question test-fun correct-response wrong-response)))
(create-question-template
"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))
t))))
(list question test-fun correct-response wrong-response)))
(create-question-template
"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))
t))))
(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>
<script type='text/javascript'
src='http://pagead2.googlesyndication.com/pagead/show_ads.js'>
</script>")
(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")
(:br)
(: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")))
(no-cache)
(with-html-output-to-string (*standard-output* nil :indent t)
(:html
(:head
(: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();"
(:center
(:p (fmt "~A" (ad-banner)))
(:h1 "Months of the Year Learning Game")
(:br)
(if (not questions) ; New Game's starting
(progn
(htm (:p (:b "Welcome to the Month Learning Game!"))
(:p (:i "Try your best to answer 10 questions about the different Months"))
(:br))
(start-session)
(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
(progn
(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-pagefunction. 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.