diff options
Diffstat (limited to 'gui.rkt')
| -rw-r--r-- | gui.rkt | 83 |
1 files changed, 83 insertions, 0 deletions
@@ -0,0 +1,83 @@ +#lang racket/gui + +(provide show-window) + +(require racket/format) +(require racket/class) +(require (planet williams/table-panel:1:2/table-panel)) +;(require table-panel) + +(require "../useful/enumerate-interval.rkt") +(require "simple-eval.rkt") +(require "simple-parse.rkt") +(require "full-eval.rkt") +(require "full-parse.rkt") + +(define (show-window) + (define frame (new frame% [label "Calculator"])) + + (define msg (new message% + [parent frame] + [label ""])) + + (define root-panel (new vertical-panel% + [parent frame] + [alignment '(left top)])) + + (define top-op-panel (new horizontal-panel% + [parent root-panel] + [alignment '(left top)])) + + (define center-panel (new horizontal-panel% + [parent root-panel] + [alignment '(left top)])) + + (define number-panel (new table-panel% + [parent center-panel] + [alignment '(left top)])) + + (define left-op-panel (new vertical-panel% + [parent center-panel] + [alignment '(left top)])) + + (define bottom-op-panel (new horizontal-panel% + [parent root-panel] + [alignment '(left top)])) + + (send number-panel set-dimensions 3 3) + + + (define (setup-num-btn lbl par) + (new button% + [parent par] + [label (~a lbl)] + [callback + (lambda (button event) + (send msg + set-label + (string-append + (send msg get-label) + (send button get-label))))])) + + (map (lambda (x) (setup-num-btn x top-op-panel)) '("(" ")" "/")) + + (map + (lambda (x) (setup-num-btn x number-panel)) + (enumerate-interval 1 9)) + (map + (lambda (x) (setup-num-btn x left-op-panel)) + '(* - +)) + (map + (lambda (x) (setup-num-btn x bottom-op-panel)) + '(0 "." ^ )) + + + (new button% + [parent bottom-op-panel] + [label "="] + [callback + (lambda (button event) + (send msg set-label (~a + (full-eval (full-parse (send msg get-label))))))]) + + (send frame show #t)) |