Initial commit

5 files changed, 137 insertions, 0 deletions

diff --git a/full-eval.rkt b/full-eval.rkt
new file mode 100644
index 0000000..1a82dff
--- /dev/null
+++ b/full-eval.rkt
@@ -0,0 +1,7 @@
+#lang racket
+
+(provide full-eval)
+
+(define (full-eval expr)
+  (eval expr))
+
diff --git a/full-parse.rkt b/full-parse.rkt
new file mode 100644
index 0000000..25239a2
--- /dev/null
+++ b/full-parse.rkt
@@ -0,0 +1,34 @@
+#lang racket
+
+(provide full-parse)
+
+; + - * / ^ ( ) [0-9]
+
+(define (full-parse str)
+  (define (get-general expr operator next-operation)
+    (define (char->wanted c)
+      ((if (char-numeric? c)
+        string->number string->symbol)
+       (string c)))
+    (define (add-operation-to-list operation seq)
+      (cons (if (= (length operation) 1) 
+              (char->wanted (car operation))
+              (next-operation operation))
+            seq))
+    (define (inner cfac facts rexpr)
+      (cond
+        ((null? rexpr)
+         (reverse (add-operation-to-list cfac facts)))
+        ((eqv? (car rexpr) operator)
+         (inner '() (add-operation-to-list cfac facts) (cdr rexpr)))
+        (else
+          (inner (cons (car rexpr) cfac) facts (cdr rexpr)))))
+    (cons (char->wanted operator) (inner '() '() expr)))
+
+  (define (get-parts expr)
+    (get-general 
+      expr 
+      #\+ 
+      (lambda (expr)
+        (get-general expr #\* (lambda (x) x)))))
+  (get-parts (string->list str)))
diff --git a/gui.rkt b/gui.rkt
new file mode 100644
index 0000000..98b4f77
--- /dev/null
+++ b/gui.rkt
@@ -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))
diff --git a/simple-eval.rkt b/simple-eval.rkt
new file mode 100644
index 0000000..4cf6d4a
--- /dev/null
+++ b/simple-eval.rkt
@@ -0,0 +1,7 @@
+#lang racket
+
+(provide simple-eval)
+
+(define (simple-eval expr)
+  5)
+
diff --git a/simple-parse.rkt b/simple-parse.rkt
new file mode 100644
index 0000000..b60f5ec
--- /dev/null
+++ b/simple-parse.rkt
@@ -0,0 +1,6 @@
+#lang racket
+
+(provide simple-parse)
+
+(define (simple-parse str)
+  '(5))