sunet/scheme/httpd/surflets/web-server/root/surflets/byte-input.scm

65 lines
1.6 KiB
Scheme

(define-structure surflet surflet-interface
(open surflets
surflet-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):")
(surflet-form ,new-url
,byte-input-fields
,(make-submit-button))
(hr)
(p (URL "/" "Return to main menu.")))))))
(bindings (form-query (http-url-search (surflet-request-url req)))))
(input-field-value byte-input-fields bindings)))
(define (main req)
(show-result (get-byte-input)))
))