2003-01-19 11:57:27 -05:00
|
|
|
(define-structure surflet surflet-interface
|
|
|
|
(open surflets
|
2003-02-17 05:09:24 -05:00
|
|
|
surflet-requests
|
2003-04-16 08:30:57 -04:00
|
|
|
surflets/my-input-fields
|
2002-09-27 13:30:11 -04:00
|
|
|
handle-fatal-error
|
|
|
|
url
|
2002-12-08 10:49:27 -05:00
|
|
|
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
|
2003-07-08 17:22:06 -04:00
|
|
|
(make-annotated-checkbox order)
|
2002-09-27 13:30:11 -04:00
|
|
|
(loop (+ 1 count)
|
|
|
|
(* 2 order))))))))
|
2003-07-08 17:22:06 -04:00
|
|
|
|
2003-04-16 08:30:57 -04:00
|
|
|
(make-multi-input-field
|
|
|
|
#f "byte-input"
|
2003-05-22 09:32:49 -04:00
|
|
|
(lambda (input-field bindings)
|
2002-09-27 13:30:11 -04:00
|
|
|
(let loop ((sum 0)
|
|
|
|
(checkboxes checkboxes))
|
|
|
|
(if (null? checkboxes)
|
|
|
|
sum
|
2003-04-16 08:30:57 -04:00
|
|
|
(loop (+ sum (or (input-field-value (car checkboxes) bindings)
|
|
|
|
0))
|
2002-09-27 13:30:11 -04:00
|
|
|
(cdr checkboxes)))))
|
2003-04-16 08:30:57 -04:00
|
|
|
'()
|
|
|
|
(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")
|
2002-10-21 04:38:46 -04:00
|
|
|
(p "You've entered " ,result ".")
|
|
|
|
(hr)
|
2003-03-09 15:15:08 -05:00
|
|
|
(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
|
2002-10-21 04:38:46 -04:00
|
|
|
,(make-submit-button))
|
|
|
|
(hr)
|
2003-03-09 15:15:08 -05:00
|
|
|
(p (url "/" "Return to main menu.")))))))
|
2003-03-09 14:57:56 -05:00
|
|
|
(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)))
|
|
|
|
|
|
|
|
|
|
|
|
))
|