-
Notifications
You must be signed in to change notification settings - Fork 2
/
Calc.cp
214 lines (192 loc) · 6.46 KB
/
Calc.cp
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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
MODULE ObxCalc;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
issues = ""
**)
IMPORT Stores, Ports, Views, Properties, Controllers, Dialog, Fonts, Strings;
CONST minVersion = 0; maxVersion = 0; mm = Ports.mm; CR = 0DX;
TYPE
Stack = POINTER TO RECORD
next: Stack;
val: INTEGER
END;
View = POINTER TO RECORD (Views.View)
stack: Stack;
editMode, enterMode: BOOLEAN
END;
VAR
font: Fonts.Font;
labels: ARRAY 21 OF CHAR;
PROCEDURE LocateField (v: View; f: Views.Frame; x, y: INTEGER; VAR i, j: INTEGER;
VAR valid: BOOLEAN);
BEGIN
x := x DIV mm - 3; y := y DIV mm - 12; i := SHORT(x DIV 9); j := SHORT(y DIV 9);
valid := (i >= 0) & (i < 4) & (j >= 0) & (j < 5) & (x MOD 9 < 7) & (y MOD 9 < 7)
END LocateField;
PROCEDURE SelectField (v: View; f: Ports.Frame; i, j: INTEGER);
CONST point = Ports.point;
VAR x, y: INTEGER;
BEGIN
x := (3 + i * 9) * mm; y := (12 + j * 9) * mm;
f.MarkRect(x + point, y + point, x + 6 * mm - point, y + 6 * mm - point, Ports.fill, Ports.hilite, TRUE)
END SelectField;
PROCEDURE HandleKey (v: View; i, j: INTEGER);
VAR k, n: INTEGER; s: Stack;
BEGIN
k := j*4 + i; s := v.stack;
IF k IN {0, 1, 2, 3, 7, 11, 15} THEN
IF s.next # NIL THEN
IF k = 0 THEN (* swap *) s := s.next; v.stack.next := s.next; s.next := v.stack; v.stack := s
ELSIF k = 1 THEN v.stack := s.next
ELSIF k IN {2, 3} THEN
IF s.val = 0 THEN Dialog.Beep
ELSIF k = 2 THEN s.next.val := s.next.val MOD s.val; v.stack := s.next
ELSE s.next.val := s.next.val DIV s.val; v.stack := s.next
END
ELSIF k = 7 THEN s.next.val := s.next.val * s.val; v.stack := s.next
ELSIF k = 11 THEN s.next.val := s.next.val - s.val; v.stack := s.next
ELSIF k = 15 THEN s.next.val := s.next.val + s.val; v.stack := s.next
END
ELSE
IF k = 0 THEN NEW(s); s.val := 0; s.next := v.stack; v.stack := s
ELSIF k = 11 THEN s.val := -s.val
ELSIF k = 15 THEN (* skip *)
ELSE s.val := 0
END
END;
v.editMode := FALSE
ELSIF k = 18 THEN (* ± *)
s.val := - s.val
ELSIF k = 16THEN (* delete *)
IF v.editMode THEN s.val := s.val DIV 10
ELSE s.val := 0; v.editMode := TRUE
END
ELSIF k = 19 THEN (* enter *)
NEW(s); s.val := v.stack.val; s.next := v.stack; v.stack := s;
v.editMode := FALSE
ELSE (* edit operation *)
IF k = 17 THEN (* 0 *) n := 0 ELSE n := (3-j)*3 + 1 + i END;
IF ~v.editMode & ~v.enterMode THEN
NEW(s); s.val := n; s.next := v.stack; v.stack := s; v.editMode := TRUE
ELSIF ~v.editMode THEN s.val := n; v.editMode := TRUE
ELSIF s.val >= 0 THEN
IF s.val > (MAX(INTEGER) - n) DIV 10 THEN Dialog.Beep ELSE s.val := 10*s.val + n END
ELSE
IF s.val < (MIN(INTEGER) + n) DIV 10 THEN Dialog.Beep ELSE s.val := 10*s.val - n END
END
END;
v.enterMode := k = 19;
Views.Update(v, Views.keepFrames)
END HandleKey;
PROCEDURE Track (v: View; f: Views.Frame; x, y: INTEGER; buttons: SET);
VAR i, j, i1, j1: INTEGER; isDown, valid, sel: BOOLEAN; m: SET;
BEGIN
LocateField(v, f, x, y, i, j, sel);
IF sel THEN
SelectField(v, f, i, j);
REPEAT f.Input(x, y, m, isDown);
LocateField(v, f, x, y, i1, j1, valid);
IF ~valid OR (i1 # i) OR (j1 # j) THEN
IF sel THEN sel := FALSE; SelectField(v, f, i, j) END
ELSE
IF ~sel THEN sel := TRUE; SelectField(v, f, i, j) END
END
UNTIL ~isDown;
IF sel THEN HandleKey(v, i, j); SelectField(v, f, i, j) END
END
END Track;
PROCEDURE Init (v: View);
BEGIN
NEW(v.stack); v.stack.val := 0; v.editMode := TRUE; v.enterMode := FALSE
END Init;
(* View *)
PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
BEGIN
wr.WriteVersion(maxVersion);
END Externalize;
PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
VAR version: INTEGER;
BEGIN
rd.ReadVersion(minVersion, maxVersion, version);
IF ~rd.cancelled THEN Init(v) END
END Internalize;
PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);
BEGIN
Init(v)
END CopyFromSimpleView;
PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
VAR i, j: INTEGER; x, y, asc, dsc, w: INTEGER; s: ARRAY 2 OF CHAR;
display: ARRAY 12 OF CHAR;
BEGIN
Strings.IntToStringForm(v.stack.val, Strings.decimal, 11, " ", FALSE, display);
f.DrawRect(0, 0, 40 * mm, 58 * mm, 0, Ports.black);
f.DrawRect(3 * mm, 3 * mm, 37 * mm, 10 * mm, 0, Ports.black);
f.DrawString(6 * mm, 8 * mm, Ports.black, display, font);
j := 0;
WHILE j # 5 DO
i := 0; y := (12 + j * 9) * mm;
WHILE i # 4 DO
x := (3 + i * 9) * mm;
f.DrawRect(x, y, x + 6 * mm, y + 6 * mm, 0, Ports.black);
f.DrawRect(x + mm, y + 6 * mm, x + 7 * mm, y + 7 * mm, Ports.fill, Ports.black);
f.DrawRect(x + 6 * mm, y + Ports.mm, x + 7 * mm, y + 7 * mm, Ports.fill, Ports.black);
s[0] := labels[j * 4 + i]; s[1] := 0X;
font.GetBounds(asc, dsc, w);
f.DrawString(x + 3 * mm - w DIV 2, y + 3 * mm + asc DIV 2, Ports.black, s, font);
INC(i)
END;
INC(j)
END
END Restore;
PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
VAR focus: Views.View);
VAR i, j, k: INTEGER;
BEGIN
WITH msg: Controllers.TrackMsg DO
Track(v, f, msg.x, msg.y, msg.modifiers)
| msg: Controllers.EditMsg DO
IF msg.op = Controllers.pasteChar THEN
IF msg.char = CR THEN k := 19
ELSIF msg.char = 08X THEN k := 16
ELSE
k := 0; WHILE (k # 20) & (CAP(labels[k]) # CAP(msg.char)) DO INC(k) END
END;
IF k < 20 THEN
i := k MOD 4; j := k DIV 4;
SelectField(v, f, i, j); HandleKey(v, i, j); SelectField(v, f, i, j)
END
END
ELSE
END
END HandleCtrlMsg;
PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
BEGIN
WITH msg: Properties.ResizePref DO
msg.fixed := TRUE
| msg: Properties.SizePref DO
msg.w := 40 * mm; msg.h := 58 * mm
| msg: Properties.FocusPref DO
msg.setFocus := TRUE
ELSE
END
END HandlePropMsg;
(* commands *)
PROCEDURE New* (): View;
VAR v: View;
BEGIN
NEW(v); Init(v); RETURN v
END New;
PROCEDURE Deposit*;
BEGIN
Views.Deposit(New())
END Deposit;
BEGIN
font := Fonts.dir.This("Courier", 11 * Fonts.point, {}, Fonts.normal);
labels := "sp÷/789*456-123+C0±^"
END ObxCalc.