blob: 98b4f7771cc27a99931f3c66423b865f849d2bf9 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
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))
|
