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

67 lines
1.6 KiB
Scheme
Raw Permalink Normal View History

2003-01-19 11:57:27 -05:00
(define-structure surflet surflet-interface
(open surflets
surflet-requests
surflets/my-input-fields
2002-09-27 13:30:11 -04:00
handle-fatal-error
url
scheme-with-scsh)
2002-09-27 13:30:11 -04:00
(begin
(define (make-byte-input-fields bits)
(let ((checkboxes
(reverse
(let loop ((count 0)
(order 1))
(if (= count bits)
'()
(cons
(make-annotated-checkbox order)
2002-09-27 13:30:11 -04:00
(loop (+ 1 count)
(* 2 order))))))))
(make-multi-input-field
#f "byte-input"
(lambda (input-field bindings)
2002-09-27 13:30:11 -04:00
(let loop ((sum 0)
(checkboxes checkboxes))
(if (null? checkboxes)
sum
(loop (+ sum (or (input-field-value (car checkboxes) bindings)
0))
2002-09-27 13:30:11 -04:00
(cdr checkboxes)))))
'()
(lambda (ignore)
checkboxes))))
2002-09-27 13:30:11 -04:00
(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."))))))
2002-09-27 13:30:11 -04:00
(define (get-byte-input)
(let* ((req (send-html/suspend
(lambda (new-url)
`(html (title "Byte Input Widget")
(body
(h1 "Byte Input Widget")
2002-09-27 13:31:35 -04:00
(p "Enter your byte (msb left):")
2003-01-19 11:57:27 -05:00
(surflet-form ,new-url
2002-09-27 13:30:11 -04:00
,byte-input-fields
,(make-submit-button))
(hr)
(p (url "/" "Return to main menu.")))))))
(bindings (get-bindings req)))
2002-09-27 13:30:11 -04:00
(input-field-value byte-input-fields bindings)))
(define (main req)
(show-result (get-byte-input)))
))