calculator.scm

; Calculator for Simple Scheme

(define button-labels
  '("%"  "7" "8" "9" "÷" "MR"
    "√"  "4" "5" "6" "×" "M-"
    "C"  "1" "2" "3" "-" "M+"
    "AC" "0" "." "=" "+"))

(define width (image-width (empty-scene)))
(define (conv-x x) (/ (* width (+ 1 x)) 7))
(define (conv-y y) (/ (* width (+ 2 y)) 7))

(define-struct button-category (labels size color))
(define button-categories
  (list
   (make-button-category '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" ".") 80 "gray")
   (make-button-category '("+" "-" "×" "÷" "=" "%" "√")                 70 "black")
   (make-button-category '("MR" "M+" "M-")                              60 "blue")
   (make-button-category '("AC" "C")                                    60 "red")))

(define (place-buttons x y button-labels scn)
  (if (null? button-labels)
      scn
      (let* ((b (car button-labels))
             (bc (letrec ((find (lambda (lis)
                                  (if (ormap (lambda (l) (string=? b l))
                                             (button-category-labels (car lis)))
                                      (car lis)
                                      (find (cdr lis))))))
                   (find button-categories)))
             (scn (place-image (text b (button-category-size bc)
                                     (button-category-color bc))
                               (conv-x x) (conv-y y) scn)))
        (if (>= x 5)
            (place-buttons 0 (++ y) (cdr button-labels) scn)
            (place-buttons (++ x) y (cdr button-labels) scn)))))

(define keyboard (place-buttons 0 0 button-labels (empty-scene)))

(show-image keyboard)