diff options
author | Hugo <hugo.hornquist@gmail.com> | 2016-04-26 21:43:34 +0200 |
---|---|---|
committer | Hugo <hugo.hornquist@gmail.com> | 2016-04-26 21:43:34 +0200 |
commit | c7e952829c248a259c1be2f0a451cba1b3c86723 (patch) | |
tree | facea175e602cad2dd97a9f81c398dd6740885cb /gui.rkt | |
download | math-parse-c7e952829c248a259c1be2f0a451cba1b3c86723.tar.gz math-parse-c7e952829c248a259c1be2f0a451cba1b3c86723.tar.xz |
Initial commit
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)) |