;;;; This is a LAML questionnaire style. It is based on the html4.0-loose libraries. ;;;; The main function is questionnaire. Besides this function and its helping functions, ;;;; a collection of useful quetionnaire functionality is collected in this style; Some ;;;; of these are used in the accompanying cgi programs. ;;;; A submitted questionnaire can be self-contained if you want; It means ;;;; that the questions and possible answers are submitted too via hidden lines. ;;;; The cgi programs rely on self contained submissions. ;;;; If a questions is identified with 'ID, the field 'ID$question' denotes the formulation ;;;; of the question. In case of multi-choice-question, single-choice-question, and rating-question ;;;; the questions themselves are submitted via hidden input lines with the answering ;;;; possibilities submitted as 'ID$answers' in a particular encoding.<p> ;;;; ;;;; The cgi programs in cgi-support (a subdirectory of the containing directory - not part of the LAML distribution) ;;;; holds a number of accompanying cgi programs which can accept and display submissions. ;;;; If you are interested in this part of the work, please contact normark@cs.aucd.dk.<p> ;;;; ;;;; Important: Avoid the character '$' in both questions, answers, and ids.<p> ;;;; ;;;; Please consult the <a href="../../../examples/questionnaire/index.html">example questionnaire</a> for further information and insight. (lib-load "cgi.scm") (lib-load "html4.0-loose/basis.scm") (lib-load "html4.0-loose/surface.scm") (lib-load "html4.0-loose/convenience.scm") ; (lib-load "html.scm") ; (lib-load "html-v1.scm") (lib-load "color.scm") (lib-load "time.scm") (lib-load "file-read.scm") ;;; Front matters. ;;; The functions and variables in this section are front matters to the real questionnaire. ;; Hidden answers. In some situations we might want (in an adhoc fashion) to ;; hide certain answers. The answers to the questions ids in hidden-ids are not shown. Intial value is the empty list. (define hidden-ids '()) (define laml-source-file-name-without-extension (source-filename-without-extension scheme-system)) (define target-extension "html") ;; Is the submitted questionnaire self contained? (define questionnaire-self-contained #t) ;; The questionnaire color scheme. ;; A list of four colors: background, foreground, link, visited links colors. (define questionnaire-color-scheme (list green1 black blue blue)) ;; The font size of a questionnaire (define questionnaire-font-size 3) ;; Question emphasis function. This function is applied on any question text. (define question-emphasis-function (lambda (q) (b (font-1 3 red q)))) ; color scheme selectors (general) (define background-of-color-scheme car) (define foreground-of-color-scheme cadr) (define link-of-color-scheme caddr) (define vlink-of-color-scheme cadddr) (define question-separator (vertical-space 1)) (define col1-width 200) (define col2-width (if (<= questionnaire-font-size 2) 400 500)) (define sep-width 18) ; a list in which all id's are collected. Collected imperatively. (define all-id-list '()) ; a list of all question types. Collected imperatively. (define all-type-list '()) ; return a 'self identification'. (define (self-id id type question . answers) (let ((answers-1 (if (null? answers) #f (car answers)))) (set! all-id-list (cons id all-id-list)) (set! all-type-list (cons type all-type-list)) (con (if questionnaire-self-contained (hidden-line (string-append (as-string id) "$" "question") question) "") (if (and questionnaire-self-contained answers-1) (hidden-line (string-append (as-string id) "$" "answers") (list-to-string answers-1 "$")) "") ) ) ) ;;; Questionnaire forms. ;;; In this section you will find the top-level questionnaire form together with possible subforms. ; laml version of questionnaire function ; a plain version of the same function is questionnaire-1 ;; Write a questionnaire to a file. ;; The title is the title of the questionnaire. ;; receiving-program-url is the URL of the CGI program which processes the answers. ;; questionnaire-id is a symbol which identifies this particular questionnaire. ;; The question-list is a number of forms: identification-question, free-style-question, multi-choice-question, rating-question. (define (questionnaire title receiving-program-url questionnaire-id . question-list) (let ((file-name (string-append laml-source-file-name-without-extension "." target-extension))) (write-text-file (con (apply questionnaire-1 (append (list title receiving-program-url questionnaire-id) question-list)) (p) (hr) (p) (font-size 2 (credits "Spørgeskema-systemet" "The questionnaire system"))) file-name))) (define (questionnaire-1 title receiving-program-url questionnaire-id . question-list) (apply page (append (list title (con (h 1 title) (form-1 receiving-program-url (string-append ; questionnaire id: (if questionnaire-self-contained (hidden-line "questionnaire-id" (as-string questionnaire-id)) "") ; all questions (string-merge question-list (make-list (- (length question-list) 1) question-separator)) ; all question field names (ids): (if questionnaire-self-contained (hidden-line "all-ids" (list-to-string (map as-string (reverse all-id-list)) " ")) "") ; all question types: (if questionnaire-self-contained (hidden-line "all-types" (list-to-string (map as-string (reverse all-type-list)) " ")) "") question-separator (submit (text-choice "Indsend skema" "Submit questionnaire"))) ))) questionnaire-color-scheme))) (define (questionnaire-slice question form) (table-1 0 (list col1-width sep-width col2-width) (make-list 3 (background-of-color-scheme questionnaire-color-scheme)) (list (list (question-emphasis-function (font-size questionnaire-font-size question)) "" form)))) ;; Ask a question which requires a one line answer. ;; The answer to this question is meant to identify a particular answer relative to other answers. ;; Thus, typically ask for the name of the submitter in an identification question. ;; Id is the identification of this question (a symbol). ;; .internal-references "Alternative form" "free-style-question" (define (identification-question id question) (con (self-id id 'identification question) (questionnaire-slice question (text-line (as-string id) 60 "")) ) ) ;; Ask a question which requires a multi-line answer. ;; The id is the identification of this question (a symbol). (define (free-style-question id question) (con (self-id id 'free-style question) (questionnaire-slice question (textarea-1 (as-string id) 5 60 "")) ) ) ;; Ask a multi-choice question. ;; Possibilities is a list of possible answers. ;; One or more answers can be selected. ;; The id is the identification of this question (a symbol). (define (multi-choice-question id question possibilities) (con (self-id id 'multi-choice question possibilities) (questionnaire-slice question (choice-list-sequence possibilities id)) ) ) (define (choice-list-sequence possibilities id) (let ((answer-numbers (number-interval 1 (length possibilities)))) (string-merge (map2 (lambda (possibility n) (con (checkbox (string-append (as-string id) "-" (as-string n))) (space 2) (font-size questionnaire-font-size possibility))) possibilities answer-numbers) (make-list (- (length possibilities) 1) (br))))) ;; Ask a rating question. ;; The question can be answered by selecting exactly one of answers presenting in the rating-list. ;; Gives entry ("id" . "n"), where n is the entry selected. ;; The first is number 1. ;; The id is the identification of this question (a symbol). ;; Rating-list is a list of strings. (define (rating-question id question rating-list) (con (self-id id 'rating question rating-list) (questionnaire-slice question (rating-list-sequence rating-list id)) ) ) (define (rating-list-sequence rating-list id) (let ((rating-numbers (number-interval 1 (length rating-list)))) (string-merge (map2 (lambda (rating-text rating-numb) (con (radio-button rating-numb id) (space 2) (font-size questionnaire-font-size rating-text))) rating-list rating-numbers) (make-list (- (length rating-list) 1) (br))))) ;; As a question which can be answered by choosing one answer among a selection of possible answers. ;; Same form as rating question. However, the ordering of the answers is not important for single-choice-question. ;; .form (single-choice-question id question possible-answers) (define single-choice-question rating-question) ; --------------------------------------------------------------------------------------------------------------- ;;; CGI relevant stuff. ;;; In sub-directory cgi-support of the directory holding the questionnaire.scm file, there is a number ;;; of CGI Scheme programs, which accepts answers and display the results of the questioning It is up to ;;; the administrator of the questionnaire facility (the LAML installer) to arrange that actual ;;; cgi programs are set up in an appropriate cgi-bin directory. These actual CGI programs can just load ;;; the Scheme programs in cgi-support.<p> ;;; The CGI stuff is not part of the LAML distribution. ;; show txt in a colored answer box (define (answer-box txt) (color-frame-width (rebreak-string (font-size questionnaire-font-size txt)) (make-color 255 255 128) 900)) ;; Return a symbol assembled from constituents (define (syn-con . constituents) (as-symbol (list-to-string (map as-string constituents) ""))) ;; Return a formatted answer with id and type. (define (format-answer answer-record id type) (cond ((eq? type 'identification) (format-identification-answer id answer-record)) ((eq? type 'free-style) (format-free-style-answer id answer-record)) ((eq? type 'multi-choice) (format-multi-choice-answer id answer-record)) ((eq? type 'rating) (format-rating-answer id answer-record)) (else "???"))) (define (format-identification-answer id rec) (let* ((quest (defaulted-get (syn-con id "$" "question") rec "???")) (answ (defaulted-get id rec "???")) (answ-1 (if (blank-string? answ) #f answ)) ) (questionnaire-slice quest (answer-box (if (not (memq id hidden-ids)) (if answ-1 (pre answ-1) (i (text-choice "Intet svar" "No answer"))) (i (text-choice "Skjult svar" "Answer hidden"))) )))) (define (format-free-style-answer id rec) (let* ((quest (defaulted-get (syn-con id "$" "question") rec "???")) (answ (defaulted-get id rec "???")) (answ-1 (if (blank-string? answ) #f answ)) ) (questionnaire-slice quest (answer-box (if (not (memq id hidden-ids)) (if answ-1 (pre answ-1) (i (text-choice "Intet svar" "No answer"))) (i (text-choice "Skjult svar" "Answer hidden"))) )))) (define (format-multi-choice-answer id rec) (let* ((quest (defaulted-get (syn-con id "$" "question") rec "???")) (possible-answers (string-to-list (defaulted-get (syn-con id "$" "answers") rec "???") (list #\$))) (number-of-answers (length possible-answers)) (checked-answers (map (lambda (n) (defaulted-get (syn-con id "$" n) rec #f)) (number-interval 1 number-of-answers))) ) (questionnaire-slice quest (if (not (memq id hidden-ids)) (answer-box (con (list-to-string (map2 (lambda (answer checked) (if checked answer "")) possible-answers checked-answers) (p)) (br))) (i (text-choice "Skjult svar" "Answer hidden"))) ))) (define (format-rating-answer id rec) (let* ((quest (defaulted-get (syn-con id "$" "question") rec "???")) (answer-number-selected (defaulted-get id rec #f)) (possible-answers (string-to-list (defaulted-get (syn-con id "$" "answers") rec "???") (list #\$))) ) (questionnaire-slice quest (if (not (memq id hidden-ids)) (answer-box (if answer-number-selected (let* ((n (as-number answer-number-selected)) (answer (list-ref possible-answers (- n 1)))) answer) (i (text-choice "Intet svar" "No answer")))) (i (text-choice "Skjult svar" "Answer hidden")))))) ;; Present the answer in answer-record (define (show-an-answer answer-record) (let* ((answer-date (defaulted-get 'date answer-record "???")) (answer-time (defaulted-get 'time answer-record "???")) (all-ids (map as-symbol (as-list (get 'all-ids answer-record )))) (all-types (map as-symbol (as-list (get 'all-types answer-record)))) (quest-id (get 'questionnaire-id answer-record))) (con answer-date ", " answer-time (p) (list-to-string (map2 (lambda (id type) (format-answer answer-record id type)) all-ids all-types) (p))))) |