62 lines
1.5 KiB
Scheme
62 lines
1.5 KiB
Scheme
(define-structure servlet servlet-interface
|
|
(open servlets
|
|
httpd-request
|
|
handle-fatal-error
|
|
url
|
|
scsh
|
|
scheme)
|
|
(begin
|
|
|
|
;; This doesn't use c-a-l-l-b-a-c-k-s anymore.
|
|
|
|
(define (make-byte-input-fields bits)
|
|
(let ((checkboxes
|
|
(reverse
|
|
(let loop ((count 0)
|
|
(order 1))
|
|
(if (= count bits)
|
|
'()
|
|
(cons
|
|
(make-checkbox-input-field (number->string order))
|
|
(loop (+ 1 count)
|
|
(* 2 order))))))))
|
|
(make-upper-input-field
|
|
(lambda (bindings)
|
|
(let loop ((sum 0)
|
|
(checkboxes checkboxes))
|
|
(if (null? checkboxes)
|
|
sum
|
|
(loop (+ sum (string->number
|
|
(with-fatal-error-handler
|
|
(lambda (condition decline) "0")
|
|
(input-field-value (car checkboxes) bindings))))
|
|
(cdr checkboxes)))))
|
|
checkboxes)))
|
|
|
|
(define byte-input-fields (make-byte-input-fields 8))
|
|
|
|
(define (show-result result)
|
|
(send-html
|
|
`(html (title "Result")
|
|
(body
|
|
(h2 "Result")
|
|
(p "You've entered " ,result ".")))))
|
|
|
|
(define (get-byte-input)
|
|
(let* ((req (send-html/suspend
|
|
(lambda (new-url)
|
|
`(html (title "Byte Input Widget")
|
|
(body
|
|
(h1 "Byte Input Widget")
|
|
(p "Enter your byte (msb left):")
|
|
(servlet-form ,new-url
|
|
,byte-input-fields
|
|
,(make-submit-button)))))))
|
|
(bindings (form-query (http-url:search (request:url req)))))
|
|
(input-field-value byte-input-fields bindings)))
|
|
|
|
(define (main req)
|
|
(show-result (get-byte-input)))
|
|
|
|
|
|
)) |