Browse code

The calculator can now add

neauoire authored on 19/09/2021 04:25:50
Showing 1 changed files
... ...
@@ -5,7 +5,8 @@
5 5
 %++ { ADD2 } %-- { SUB2 }              %// { DIV2 }
6 6
 %<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
7 7
 
8
-%4/   { #02 SFT }
8
+%2* { #10 SFT } 
9
+%4/ { #02 SFT }
9 10
 %4* { #20 SFT }
10 11
 %2**  { #10 SFT2 } %2// { #01 SFT2 }
11 12
 %4** { #20 SFT2 }
... ...
@@ -42,6 +43,9 @@
42 43
 
43 44
 @input
44 45
 	&length $1 &value $2
46
+@stack
47
+	&length $1
48
+	&items $10
45 49
 @center
46 50
 	&x $2 &y $2
47 51
 @rect
... ...
@@ -51,9 +55,9 @@
51 55
 @keypad-frame
52 56
 	&x $2 &y $2 &x2 $2 &y2 $2
53 57
 @modpad-frame
54
-	&x $2 &y $2
58
+	&x $2 &y $2 &x2 $2 &y2 $2
55 59
 @input-frame
56
-	&x $2 &y $2
60
+	&x $2 &y $2 &x2 $2 &y2 $2
57 61
 
58 62
 ( program )
59 63
 
... ...
@@ -78,11 +82,19 @@
78 82
 	DUP2 .keypad-frame/y STZ2
79 83
 		#0040 ++ .keypad-frame/y2 STZ2
80 84
 
81
-	.keypad-frame/x LDZ2 #0040 ++ .modpad-frame/x STZ2
82
-	.keypad-frame/y LDZ2 .modpad-frame/y STZ2
85
+	.keypad-frame/x LDZ2 #0040 ++ 
86
+	DUP2 .modpad-frame/x STZ2
87
+		#0010 ++ .modpad-frame/x2 STZ2
88
+	.keypad-frame/y LDZ2 
89
+	DUP2 .modpad-frame/y STZ2
90
+		#0040 ++ .modpad-frame/y2 STZ2
83 91
 
84
-	.center/x LDZ2 #0010 -- .input-frame/x STZ2
85
-	.center/y LDZ2 #0030 -- .input-frame/y STZ2
92
+	.center/x LDZ2 #0010 -- 
93
+	DUP2 .input-frame/x STZ2
94
+		#0040 ++ .input-frame/x2 STZ2
95
+	.center/y LDZ2 #0030 -- 
96
+	DUP2 .input-frame/y STZ2
97
+		#0010 ++ .input-frame/y2 STZ2
86 98
 
87 99
 	;on-mouse .Mouse/vector DEO2
88 100
 
... ...
@@ -109,24 +121,60 @@ BRK
109 121
 
110 122
 	.Mouse/state DEI BRK?
111 123
 
112
-	.Mouse/x DEI2 
113
-	.Mouse/y DEI2 
114
-	.keypad-frame 
124
+	.Mouse/x DEI2 .Mouse/y DEI2 
125
+	OVR2 OVR2 .keypad-frame 
115 126
 		;within-rect JSR2 ;click-keypad JCN2
127
+	OVR2 OVR2 .input-frame 
128
+		;within-rect JSR2 ;click-input JCN2
129
+	OVR2 OVR2 .modpad-frame 
130
+		;within-rect JSR2 ;click-modpad JCN2
131
+	POP2 POP2
116 132
 
117 133
 BRK
118 134
 
119
-@click-keypad ( -> )
135
+@click-keypad ( x* y* -> )
120 136
 
121 137
 	( get key )
122
-	.Mouse/x DEI2 .keypad-frame/x LDZ2 -- 10// 4MOD
123
-	.Mouse/y DEI2 .keypad-frame/y LDZ2 -- 10// 4**
138
+	.keypad-frame/y LDZ2 -- 10// 4**
139
+	SWP2 .keypad-frame/x LDZ2 -- 10// #0003 AND2
124 140
 	++ ;keypad/layout ++ LDA ;push-key JSR2
125 141
 
126 142
 	( release mouse ) #00 .Mouse/state DEO
127 143
 
128 144
 BRK
129 145
 
146
+@click-modpad ( x* y* -> )
147
+
148
+	NIP2
149
+	( get key )
150
+	.modpad-frame/y LDZ2 -- 10// NIP
151
+	DUP #00 ! ,&no-add JCN
152
+		;pop JSR2
153
+		;pop JSR2
154
+		ADD2 ;push JSR2
155
+		&no-add
156
+	POP
157
+
158
+	( release mouse ) #00 .Mouse/state DEO
159
+
160
+BRK
161
+
162
+@click-input ( x* y* -> )
163
+
164
+	POP2
165
+	.input-frame/x LDZ2 #0008 ++ -- 10// NIP
166
+	DUP #01 ! ,&no-push JCN
167
+		.input/value LDZ2 ;push JSR2
168
+		&no-push
169
+	DUP #02 ! ,&no-pop JCN
170
+		;pop JSR2 POP2
171
+		&no-pop
172
+	POP
173
+
174
+	( release mouse ) #00 .Mouse/state DEO
175
+
176
+BRK
177
+
130 178
 @push-key ( key -- )
131 179
 
132 180
 	TOS .input/value LDZ2 #40 SFT2 ++ .input/value STZ2
... ...
@@ -135,11 +183,62 @@ BRK
135 183
 
136 184
 RTN
137 185
 
186
+@push ( value* -- )
187
+
188
+	( store ) .stack/length LDZ 2* .stack/items + STZ2
189
+	( incr ) .stack/length LDZ INC .stack/length STZ
190
+	( reset ) #0000 .input/value STZ2
191
+	;draw-input JSR2
192
+	;draw-stack JSR2
193
+
194
+RTN
195
+
196
+@pop ( -- value* )
197
+
198
+	.stack/length LDZ #01 - 2* .stack/items + LDZ2
199
+	( clear ) #0000 .stack/length LDZ #01 - 2* .stack/items + STZ2
200
+	( incr ) .stack/length LDZ #01 - .stack/length STZ
201
+	;draw-input JSR2
202
+	;draw-stack JSR2
203
+
204
+RTN
205
+
138 206
 @redraw ( -- )
139 207
 
140 208
 	;draw-keypad JSR2
141 209
 	;draw-modpad JSR2
142 210
 	;draw-input JSR2
211
+	;draw-stack JSR2
212
+
213
+RTN
214
+
215
+@draw-stack ( -- )
216
+
217
+	#08 #00
218
+	&loop
219
+		( value ) DUP 2* .stack/items + LDZ2 STH2
220
+		( y ) DUP TOS 8** #0070 SWP2 -- STH2
221
+		( x ) #0088 STH2r STH2r #01 ;draw-short JSR2
222
+		INC GTHk ,&loop JCN
223
+	POP2
224
+
225
+RTN
226
+
227
+@draw-short ( x* y* value* color -- )
228
+
229
+	POP STH2
230
+	.Screen/y DEO2
231
+	.Screen/x DEO2
232
+
233
+	#04 #00
234
+	&loop
235
+		.Screen/x DEI2 #0008 -- .Screen/x DEO2
236
+		( value ) DUP STH2kr ROT 4* SFT2 #000f AND2
237
+		( value glyph ) 8** ;font-hex ++ .Screen/addr DEO2
238
+		#01 .Screen/sprite DEO
239
+		INC GTHk ,&loop JCN
240
+	POP2
241
+	POP2r
143 242
 
144 243
 RTN
145 244