+ small calculator
+ shows usage of ++ callbacks (two submitbuttons) ++ creation of own input fields
This commit is contained in:
parent
376a8b1a70
commit
db3c5ef04e
|
@ -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"))
|
||||
))
|
Loading…
Reference in New Issue