;; SUI
;; 6.891 Spring 2006
;;
;; Calculator example
;;
;; $Id: calculator.scm 67 2006-05-17 11:29:02Z nelhage $

(load "suid.scm")

(define (iota to #!optional from increment)
  (define (step where)
    (if (>= where to)
        '()
        (cons where (step (+ where increment)))))
  (if (default-object? from) (set! from 0))
  (if (default-object? increment) (set! increment 1))
  (step from))

;; can be new-number or continue-number
(define *input-mode* 'new-number)
(define *operator* +)
(define *operands* '())

(define (make-number-clicked n)
  (lambda (event)
    (let* ((frame (event-frame event))
           (textbox (find-widget-named frame 'text)))
      (case *input-mode*
        ((new-number)
         (set-textbox-text!
          textbox
          (number->string n))
         (set! *input-mode* 'continue-number))
        ((continue-number)
         (set-textbox-text!
          textbox
          (string-append (textbox-text textbox)
                         (number->string n))))))))

(define (make-op-clicked label op)
  (lambda (event)
    (let* ((frame (event-frame event))
           (textbox (find-widget-named frame 'text)))
      (set! *input-mode* 'new-number)
      (if (eq? *operator* op)
          (begin
            (push-operand textbox))
          (let ((res (perform-op)))
            (set! *operands* (list res))
            (set! *operator* op))))))

(define (equals-clicked event)
  (let* ((frame (event-frame event))
         (textbox (find-widget-named frame 'text)))
    (push-operand textbox)
    (let ((res (perform-op)))
      (set-textbox-text! textbox (number->string res))
      (set! *input-mode* 'new-number))))

(define (perform-op)
  (apply *operator* (reverse *operands*)))

(define (push-operand textbox)
  (set! *operands* (cons (string->number (textbox-text textbox))
                         *operands*)))

(define gui
  (frame
   "A calculator!"
   (column-layout
    (row-layout
     (apply grid-layout
      3
      (map (lambda (n)
             (button (symbol 'button- n)
                          (number->string n)
                          (make-number-clicked n)))
                        (iota 10 1)))
     (apply column-layout
      (append
       (map (lambda (label op)
              (button (symbol-append 'button- label)
                      (symbol->string label)
                      (make-op-clicked label op)))
            '(+ - * /)
            (list + - * /))
       (list (button 'button-=
                          "="
                          equals-clicked)))))
    (textbox 'text "" ))))