65 lines
1.6 KiB
Scheme
65 lines
1.6 KiB
Scheme
(define-structure servlet servlet-interface
|
|
(open servlets
|
|
httpd-requests
|
|
handle-fatal-error
|
|
url
|
|
scheme-with-scsh)
|
|
(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-higher-input-field
|
|
(lambda (bindings)
|
|
(let loop ((sum 0)
|
|
(checkboxes checkboxes))
|
|
(if (null? checkboxes)
|
|
sum
|
|
(loop (+ sum (string->number
|
|
(or (input-field-value (car checkboxes) bindings)
|
|
"0")))
|
|
(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 ".")
|
|
(hr)
|
|
(p (URL "byte-input.scm" "Make new byte input.") (br)
|
|
(URL "/" "Return to main menu."))))))
|
|
|
|
(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))
|
|
(hr)
|
|
(p (URL "/" "Return to main menu.")))))))
|
|
(bindings (form-query (http-url-search (request-url req)))))
|
|
(input-field-value byte-input-fields bindings)))
|
|
|
|
(define (main req)
|
|
(show-result (get-byte-input)))
|
|
|
|
|
|
)) |