;;;-*- Mode: Lisp; Package: HTTP-DEMO -*-

(in-package :http-user)

;
; Quiz example
;

(defmacro with-page ((url stream title) &body body)
  "Provides the response function to emit a page body."
  `(with-successful-response (,stream :html)
     (with-html-document (:stream ,stream)
       (with-document-preamble (:stream ,stream)
         (declare-title ,title :stream ,stream))
       (with-document-body (:stream ,stream)
         (with-section-heading (,title :stream ,stream)
           ,@body)))))

(defun display-quiz (url stream)
  "The form function for a quiz. The form values are posted to the same URL."
  (with-page (url stream "So you think you know Lisp?")
    (with-fillout-form (:post url :stream stream)
      (with-paragraph (:stream stream)
        (write-string "Rate your knowledge of Lisp with the following questions. " stream)
        (write-string "Maximum score 100%." stream))
      (with-section-heading ("Which of the following are standard Common Lisp functions?" 
                             :level 3 :stream stream)
        (accept-input 'checkbox "Q1" :layout :none :stream stream
                      :choices '("neq" "dribble" "while" "mapcdr" "tenth")))
      (with-section-heading ("When was the first version of Lisp specified?" :level 3 :stream stream)
        (accept-input 'radio-button "Q2" 
                      :choices '("1938" "1985" "1958" "1948" "1984") :layout :none :stream stream ))
      (with-section-heading ("Which of the following features are a standard part of Common Lisp?"
                             :level 3 :stream stream)
        (accept-input 'checkbox "Q3" :layout :none :stream stream
                      :choices '("Streams" "Swirls" "Monads" "Series" "Structures")))
      (with-paragraph (:stream stream)
        (accept-input 'submit-button "Submit" :stream stream)))))

(defun mark (values answers)
  (reduce #'+ (if (listp values) values (list values)) 
          :key #'(lambda (str) (nth (parse-integer str) answers))))

(defun mark-quiz (url stream alist)
  "The response function for the quiz. This processes the form values and displays the result."
  (declare (ignore url))
  (bind-query-values (q1 q2 q3) (url alist)
    (let* ((total (+ (mark q1 '(-1 1 -1 -1 1)) 
                     (mark q2 '(0 0 2 0 0)) 
                     (mark q3 '(1 -1 -1 -1 1))))
           (score (round (* (+ total 6) 100) 12)))
      (with-page (url stream "Result")
        (with-paragraph (:stream stream) 
          (cond
           ((> score 80)
            (format stream "Well done - your result is: ~a%" score))
           ((> score 50)
            (format stream "Not bad - your result is: ~a%" score))
           (t
            (format stream "Pretty poor - your result is: ~a%" score))))))))

(export-url "http://localhost:8000/quiz.html"
            :html-computed-form
            :form-function 'display-quiz
            :response-function 'mark-quiz)