(module wordspeed mzscheme (require (lib "servlet.ss" "web-server") (lib "servlet-sig.ss" "web-server") (lib "servlet-helpers.ss" "web-server") (lib "list.ss")) (provide interface-version timeout start) (define interface-version 'v1) (define timeout +inf.0) (define (random-permutation l) (cond [(null? l) null] [else (randomly-insert (car l) (random-permutation (cdr l)))])) (define (randomly-insert item l) (let ((n (random (add1 (length l))))) (let loop ((l l) (i 0)) (cond [(= i n) (cons item l)] [else (cons (car l) (loop (cdr l) (add1 i)))])))) (define (get-coord str width) (extract-binding/single 'click.x (request-bindings (send/suspend (lambda (k) `(html (head (title "Trial")) (body (form ((action ,k)) (label "How fast is the word \"" ,str "\"?") (table (tr (td ((align "left")) "Slowest") (td ((align "center")) (input ((type "image") (ismap "ismap") (src "broken.gif") (name "click") (height "10") (width ,(number->string width))))) (td ((align "center")) "Fastest"))))))))))) (define (start initial-request) (let* ((words '("saunter" "sally" "mosey" "walk" "amble" "stroll" "run" "speed" "fly" "zoom" "march" "sprint" "dash")) (bar-width 400) (nums (map (lambda (x) (cons x (get-coord x bar-width))) (random-permutation words))) (data (quicksort nums (lambda (a b) (memq (car b) (memq (car a) words))))) (num->% (lambda (p) (string-append (number->string (round(* 100 (/ (string->number (cdr p)) bar-width)))) "%")))) (send/finish `(html (head (title "Results")) (body (table (thead (th "Word") (th "Position Clicked") (th "How far to the right?")) ,@(map (lambda (p) `(tr (td ,(car p)) (td ,(cdr p)) (td ,(num->% p)))) data))))))))