diff --git a/scheme/httpd/surflets/web-server/root/htdocs/index.html b/scheme/httpd/surflets/web-server/root/htdocs/index.html index eaa2c9e..00f5724 100644 --- a/scheme/httpd/surflets/web-server/root/htdocs/index.html +++ b/scheme/httpd/surflets/web-server/root/htdocs/index.html @@ -11,6 +11,7 @@
  • Adding (version 1)
  • Adding (version 2)
  • Simple Calculator
  • +
  • Byte Input Widget
  • This file
  • @@ -20,7 +21,7 @@
    -Last modified: Fri Sep 27 17:34:58 CEST 2002 +Last modified: Fri Sep 27 19:34:15 CEST 2002 diff --git a/scheme/httpd/surflets/web-server/root/surflets/byte-input.scm b/scheme/httpd/surflets/web-server/root/surflets/byte-input.scm new file mode 100644 index 0000000..6551aa7 --- /dev/null +++ b/scheme/httpd/surflets/web-server/root/surflets/byte-input.scm @@ -0,0 +1,64 @@ +(define-structure plugin plugin-interface + (open servlets + httpd-request + handle-fatal-error + url + scsh + scheme) + (begin + + ;; This uses callbacks. + + (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 + (call-with-current-continuation + (lambda (exit) + (with-fatal-error-handler + (lambda (condition decline) + (exit "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") + (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))) + + + )) \ No newline at end of file