+ small calculator

+ shows usage of
 ++ callbacks (two submitbuttons)
 ++ creation of own input fields
This commit is contained in:
interp 2002-09-27 15:31:26 +00:00
parent 376a8b1a70
commit db3c5ef04e
1 changed files with 87 additions and 0 deletions

View File

@ -0,0 +1,87 @@
(define-structure plugin plugin-interface
(open servlets
httpd-request
scsh
scheme)
(begin
;; This uses callbacks.
(define *operator-alist*
`(("+" . ,+)
("-" . ,-)
("*" . ,*)
("/" . ,/)))
(define operator-symbol car)
(define operator-operator cdr)
(define operator-input-field
(let ((name (generate-input-field-name "operator")))
(make-input-field
name
(lambda (operator-string)
(cond
((assoc operator-string *operator-alist*) =>
(lambda (a) a))
(else
(error "no such operator" operator-string))))
`(select (@ ((name ,name)))
,@(map (lambda (operator)
`(option ,(operator-symbol operator)))
*operator-alist*)))))
(define number-field1 (make-number-input-field))
(define number-field2 (make-number-input-field))
(define change-operator-callback
(make-callback
(lambda (bindings)
(change-operator
(input-field-value operator-input-field
bindings)))))
(define (show-page operator-pair)
(send-html
`(html
(title "Simple calculator")
(body (h1 "Simple calculator")
(servlet-form
,(make-callback (lambda (bindings)
(calculate operator-pair bindings)))
(table
(tr (td "Do calculation:"))
(tr (td ,number-field1)
(td ,(operator-symbol operator-pair))
(td ,number-field2)
(td " = ")
(td ,(make-submit-button '(value "calculate"))))))
(hr)
(p "You may choose another operator:")
(servlet-form
,change-operator-callback
(table
(tr (td ,operator-input-field)
(td ,(make-submit-button '(value "change operator"))))))))))
(define (change-operator to-operation)
(show-page to-operation))
(define (calculate operator-pair bindings)
(let ((number1 (input-field-value number-field1 bindings))
(number2 (input-field-value number-field2 bindings))
(operator (operator-operator operator-pair)))
(show-result number1 (operator-symbol operator-pair) number2
(operator number1 number2))))
(define (show-result number1 operator-symbol number2 result)
(send-html
`(html (title "Calculation Result")
(body (h1 "Result")
(p ,number1 " " ,operator-symbol " " ,number2
" = " ,result)))))
(define (main req)
(show-page (car *operator-alist*))
(error "This does not return"))
))