Last active
March 18, 2020 14:49
-
-
Save brv00/d8c99866d3509e6ec8008280b72192e0 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
; 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 (iconv-x x) (round (- (/ (* 7.0 x) width) 1))) | |
(define (iconv-y y) (round (- (/ (* 7.0 y) width) 2))) | |
(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-struct button (label size color)) | |
(define buttons | |
(letrec ((find (lambda (lis b) | |
(let ((bc (car lis))) | |
(if (ormap (lambda (l) (string=? b l)) | |
(button-category-labels bc)) | |
(make-button b (button-category-size bc) | |
(button-category-color bc)) | |
(find (cdr lis) b)))))) | |
(map (lambda (l) (find button-categories l)) button-labels))) | |
(define (place-buttons x y buttons scn) | |
(if (null? buttons) | |
scn | |
(let* ((b (car buttons)) | |
(scn (place-image (text (button-label b) (button-size b) | |
(button-color b)) | |
(conv-x x) (conv-y y) scn))) | |
(if (>= x 5) | |
(place-buttons 0 (++ y) (cdr buttons) scn) | |
(place-buttons (++ x) y (cdr buttons) scn))))) | |
(define keyboard (place-buttons 0 0 buttons (empty-scene))) | |
(big-bang keyboard | |
(on-draw (lambda (b) b)) | |
(on-mouse | |
(lambda (_ x y what) | |
(if (string=? what "button-down") | |
(let ((x (iconv-x x)) (y (iconv-y y))) | |
(let ((i (+ x (* 6 y)))) | |
(if (and (<= 0 x) (< x 6) (<= 0 i) (< i 23)) | |
(let ((b (list-ref buttons i)) (x (conv-x x)) (y (conv-y y))) | |
(place-image | |
(text (button-label b) (/ (* 4 (button-size b)) 3) | |
"white") | |
x y | |
(place-image (circle 100 "solid" (button-color b)) x y | |
keyboard))) | |
keyboard))) | |
keyboard)))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment