;;;; This is a simple demo LAML document style, written for the paper ;;;; 'A Programmatic Approach to WWW authoring using functional programming', see ;;;; http://www.cs.auc.dk/~normark/laml/papers/programmatic-approach.pdf ; LAML Library loading (lib-load "file-read.scm") (lib-load "html4.0-loose/basis.scm") (lib-load "html4.0-loose/surface.scm") (lib-load "html4.0-loose/convenience.scm") (lib-load "time.scm") (lib-load "color.scm") ; Return a function which tags some information with tag-symbol (define (tag-information tag-symbol) (lambda information (cons tag-symbol information))) ; Tag function generation (define quiz-entry (tag-information 'quiz-entry)) (define question-formulation (tag-information 'question-formulation)) (define answers (tag-information 'answers)) (define answer (tag-information 'answer)) (define answer-formulation (tag-information 'answer-formulation)) (define answer-correctness (tag-information 'answer-correctness)) (define answer-clarification (tag-information 'answer-clarification)) ;;; Quiz entry selectors (define question-of-entry (make-selector-function 2)) (define answers-of-entry (make-selector-function 3)) ;;; Question selector (define formulation-of-question (make-selector-function 2)) ;;; Answer list selector (define answer-list-of-answers (make-selector-function 2)) ;;; Answer selectors (define answer-formulation-of (compose second (make-selector-function 2))) (define answer-correctness-of (compose second (make-selector-function 3))) (define answer-clarification-of (compose second (make-selector-function 4))) ;; Present the quiz list q-list (define (quiz q-lst) (write-text-file (let ((n (length q-lst))) (page "Quiz Example" (list-to-string (map2 present-quiz-entry q-lst (number-interval 1 n)) (p)))) (string-append (source-filename-without-extension) ".html"))) ; Present a single quiz entry qe, which is assigned to the number n. (define (present-quiz-entry qe n) (let* ((question (formulation-of-question (question-of-entry qe))) (answers (answer-list-of-answers (answers-of-entry qe))) (m (length answers))) (con (font-color red (b question)) (br) (list-to-string (map2 (lambda (a m) (present-answer a n m)) answers (number-interval 1 m)) (br))))) ; Present a single answer a in quiz entry n. ; This answer is assigned to the the number m. (define (present-answer a n m) (let ((formulation (answer-formulation-of a)) (answer-id (make-id n m))) (con (checkbox answer-id #f) (horizontal-space 1) formulation))) ; Make an internal answer identification string based on two numbers. (define (make-id n m) (string-append "a" "-" (as-string n) "-" (as-string m))) ; Has quiz-entry only correct or incorrect answering possibilities (define (black-or-white-quiz-entry? quiz-entry) (let ((answer-list (answer-list-of-answers (answers-of-entry quiz-entry))) (partical-correct-answer? (lambda (answer) (let ((n (answer-correctness-of answer))) (and (> n 0) (< n 100))))) ) (null? (filter partical-correct-answer? answer-list)))) ; Make a quiz entry from a list lst (define (make-quiz-entry-from-list lst) (let* ((question (first lst)) (a-lst (second lst))) (quiz-entry (question-formulation question) (answers (map make-answer-from-list a-lst))))) ; Make an answer entry from a list lst (define (make-answer-from-list lst) (let ((fo (first lst)) (co (second lst)) (cl (third lst))) (answer (answer-formulation fo) (answer-correctness co) (answer-clarification cl)))) |