Browse code

(wireworld.tal) Match colors to standard wireworld specs

neauoire authored on 07/06/2023 16:51:27
Showing 1 changed files
... ...
@@ -23,18 +23,18 @@
23 23
 
24 24
 |0000
25 25
 
26
-@color $1
27
-@pointer &x $2 &y $2
28
-@timer &frame $1 &play $1
26
+	@color $1
27
+	@pointer &x $2 &y $2
28
+	@timer &frame $1 &play $1
29 29
 
30 30
 ( program )
31 31
 
32 32
 |0100 ( -> )
33 33
 
34 34
 	( theme )
35
-	#07fe .System/r DEO2
36
-	#07b6 .System/g DEO2
37
-	#0fc6 .System/b DEO2
35
+	#0ff2 .System/r DEO2
36
+	#0d46 .System/g DEO2
37
+	#006f .System/b DEO2
38 38
 	( size )
39 39
 	#0100 .Screen/width DEO2
40 40
 	#0100 .Screen/height DEO2
... ...
@@ -44,21 +44,21 @@
44 44
 	;on-button .Controller/vector DEO2
45 45
 	( setup )
46 46
 	#01 .timer/play STZ
47
-	#01 .color STZ
47
+	#01 set-color
48 48
 	( start )
49 49
 	;world ;get-addr/current STA2
50 50
 	#1000 ;run/future STA2
51
-	;redraw JSR2
51
+	redraw
52 52
 
53 53
 BRK
54 54
 
55 55
 @on-frame ( -> )
56 56
 
57
-	.timer/play LDZ JMP BRK
57
+	.timer/play LDZ [ JMP BRK ]
58 58
 	( every 4th )
59 59
 	.timer/frame LDZk
60
-		#03 AND ,&no-run JCN
61
-			;run JSR2
60
+		#03 AND ?&no-run
61
+			run
62 62
 			&no-run
63 63
 		LDZk INC SWP STZ
64 64
 
... ...
@@ -76,7 +76,7 @@ BRK
76 76
 	.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
77 77
 	#40 .color LDZ ADD .Screen/sprite DEO
78 78
 	( paint )
79
-	.Mouse/state DEI ,on-mouse-down JCN
79
+	.Mouse/state DEI ?on-mouse-down
80 80
 
81 81
 BRK
82 82
 
... ...
@@ -84,90 +84,57 @@ BRK
84 84
 
85 85
 	.Mouse/x DEI2 #03 SFT2 NIP
86 86
 	.Mouse/y DEI2 #03 SFT2 NIP
87
-	#0202 NEQ2k NIP2 ,&no-color1 JCN
88
-		#01 .color STZ
89
-		#00 .Mouse/state DEO
87
+	#0202 NEQ2k NIP2 ?&no-color1
88
+		#01 set-color
90 89
 		POP2 BRK
91 90
 		&no-color1
92
-	#0302 NEQ2k NIP2 ,&no-color2 JCN
93
-		#02 .color STZ
94
-		#00 .Mouse/state DEO
91
+	#0302 NEQ2k NIP2 ?&no-color2
92
+		#02 set-color
95 93
 		POP2 BRK
96 94
 		&no-color2
97
-	#0402 NEQ2k NIP2 ,&no-color3 JCN
98
-		#03 .color STZ
99
-		#00 .Mouse/state DEO
95
+	#0402 NEQ2k NIP2 ?&no-color3
96
+		#03 set-color
100 97
 		POP2 BRK
101 98
 		&no-color3
102
-	#0602 NEQ2k NIP2 ,&no-toggle JCN
99
+	#0602 NEQ2k NIP2 ?&no-toggle
103 100
 		.timer/play LDZk #00 EQU SWP STZ
104 101
 		#00 .Mouse/state DEO
105
-		;draw-ui JSR2
102
+		draw-ui
106 103
 		POP2 BRK
107 104
 		&no-toggle
108 105
 	POP2
109 106
 
110 107
 	( color ) .color LDZ .Mouse/state DEI #01 GTH #00 EQU MUL
111 108
 	( cell* ) .Mouse/x DEI2 #02 SFT2 NIP .Mouse/y DEI2 #02 SFT2 NIP
112
-		;get-addr JSR2 STA
113
-	;redraw JSR2
109
+		get-addr STA
110
+	redraw
114 111
 
115 112
 BRK
116 113
 
117
-@print ( short* -- )
118
-
119
-	SWP ,&byte JSR
120
-	&byte ( byte -- ) DUP #04 SFT ,&char JSR
121
-	&char ( char -- ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
122
-
123
-JMP2r
124
-
125 114
 @on-button ( -> )
126 115
 
127 116
 	.Controller/button DEI
128
-	[ #01 ] NEQk NIP ,&no-a JCN #01 .color STZ &no-a
129
-	[ #02 ] NEQk NIP ,&no-b JCN #02 .color STZ &no-b
130
-	[ #04 ] NEQk NIP ,&no-select JCN #03 .color STZ &no-select
131
-	[ #08 ] NEQk NIP ,&no-start JCN ;world #2000 ;mclr JSR2 ;redraw JSR2 &no-start
117
+	[ #01 ] NEQk NIP ?&no-a #01 set-color &no-a
118
+	[ #02 ] NEQk NIP ?&no-b #02 set-color &no-b
119
+	[ #04 ] NEQk NIP ?&no-select #03 set-color &no-select
120
+	[ #08 ] NEQk NIP ?&no-start ;world #2000 mclr redraw &no-start
132 121
 	POP
133 122
 	( space )
134
-	.Controller/key DEI #20 NEQ ,&no-space JCN .timer/play LDZk #00 EQU SWP STZ &no-space
123
+	.Controller/key DEI #20 NEQ ?&no-space .timer/play LDZk #00 EQU SWP STZ &no-space
135 124
 
136 125
 BRK
137 126
 
138
-@draw-ui ( -- )
139
-
140
-	( colors )
141
-	#01 .Screen/auto DEO
142
-	#0010 DUP2 .Screen/x DEO2 .Screen/y DEO2
143
-	;color-icn .Screen/addr DEO2
144
-	#01 .Screen/sprite DEO
145
-	#02 .Screen/sprite DEO
146
-	#03 .Screen/sprite DEO
147
-	( toggle )
148
-	#0030 .Screen/x DEO2
149
-	;toggle-icn #00 .timer/play LDZ #30 SFT2 ADD2 .Screen/addr DEO2
150
-	#01 .Screen/sprite DEO
151
-
152
-JMP2r
127
+(
128
+@|core )
153 129
 
154
-@redraw ( -- )
130
+@set-color ( color -- )
155 131
 
156
-	;cell-icn .Screen/addr DEO2
157
-	#4000
158
-	&ver
159
-		#00 OVR #20 SFT2 .Screen/y DEO2
160
-		STHk
161
-		#4000
162
-		&hor
163
-			#00 OVR #20 SFT2 .Screen/x DEO2
164
-			DUP STHkr ,get-addr JSR LDA .Screen/sprite DEO
165
-			INC GTHk ,&hor JCN
166
-		POP2
167
-		POPr
168
-		INC GTHk ,&ver JCN
169
-	POP2
170
-	;draw-ui JSR2
132
+	.color STZ
133
+	.pointer/x LDZ2 .Screen/x DEO2
134
+	.pointer/y LDZ2 .Screen/y DEO2
135
+	;pointer-icn .Screen/addr DEO2
136
+	#40 .color LDZ ADD .Screen/sprite DEO
137
+	#00 .Mouse/state DEO
171 138
 
172 139
 JMP2r
173 140
 
... ...
@@ -179,19 +146,18 @@ JMP2r
179 146
 		#40 #00
180 147
 		&hor
181 148
 			( x,y ) DUP STHkr
182
-			( cell ) DUP2 ,get-addr JSR STH2k LDA
183
-			( transform ) ,transform JSR STH2r [ LIT2 &future $2 ] ADD2 STA
184
-			INC GTHk ,&hor JCN
149
+			( cell ) DUP2 get-addr STH2k LDA
150
+			( transform ) transform STH2r [ LIT2 &future $2 ] ADD2 STA
151
+			INC GTHk ?&hor
185 152
 		POP2
186 153
 		POPr
187
-		INC GTHk ,&ver JCN
154
+		INC GTHk ?&ver
188 155
 	POP2
189 156
 	( Swap worlds )
190 157
 	;get-addr/current LDA2k ;run/future LDA2 STH2k ADD2 SWP2 STA2
191 158
 	#0000 STH2r SUB2 ;run/future STA2
192
-	,redraw JSR
193 159
 
194
-JMP2r
160
+!redraw
195 161
 
196 162
 @get-addr ( x y -- addr* )
197 163
 
... ...
@@ -201,19 +167,19 @@ JMP2r
201 167
 
202 168
 @transform ( xy cell -- cell )
203 169
 
204
-	DUP ,&no-null JCN NIP NIP JMP2r &no-null
205
-	DUP #03 NEQ ,&no-head JCN POP POP2 #02 JMP2r &no-head
206
-	DUP #02 NEQ ,&no-tail JCN POP POP2 #01 JMP2r &no-tail
207
-	DUP #01 NEQ ,&no-cond JCN POP
170
+	DUP ?&no-null NIP NIP JMP2r &no-null
171
+	DUP #03 NEQ ?&no-head POP POP2 #02 JMP2r &no-head
172
+	DUP #02 NEQ ?&no-tail POP POP2 #01 JMP2r &no-tail
173
+	DUP #01 NEQ ?&no-cond POP
208 174
 		LITr 00
209
-		DUP2 #01 SUB ,get-addr JSR
175
+		DUP2 #01 SUB get-addr
210 176
 			( tl ) #0001 SUB2 LDAk #03 NEQ JMP INCr
211 177
 			( tc ) INC2 LDAk #03 NEQ JMP INCr
212 178
 			( tr ) INC2 LDA #03 NEQ JMP INCr
213
-		DUP2 ,get-addr JSR
179
+		DUP2 get-addr
214 180
 			( ml ) #0001 SUB2 LDAk #03 NEQ JMP INCr
215 181
 			( mr ) INC2 INC2 LDA #03 NEQ JMP INCr
216
-		INC ,get-addr JSR
182
+		INC get-addr
217 183
 			( bl ) #0001 SUB2 LDAk #03 NEQ JMP INCr
218 184
 			( bc ) INC2 LDAk #03 NEQ JMP INCr
219 185
 			( br ) INC2 LDA #03 NEQ JMP INCr
... ...
@@ -230,21 +196,59 @@ JMP2r
230 196
 	OVR2 ADD2 SWP2
231 197
 	&loop
232 198
 		STH2k #00 STH2r STA
233
-		INC2 GTH2k ,&loop JCN
199
+		INC2 GTH2k ?&loop
234 200
 	POP2 POP2
235 201
 
236 202
 JMP2r
237 203
 
238
-@pointer-icn
239
-	80c0 e0f0 f8e0 1000
240
-@cell-icn
241
-	e0e0 e000 0000 0000
242
-@color-icn
243
-	7cfe fefe fefe 7c00
244
-@toggle-icn
245
-	( pause ) 6666 6666 6666 6600
246
-	( play ) 4666 767e 7666 4600
204
+(
205
+@|drawing )
206
+
207
+@redraw ( -- )
208
+
209
+	;cell-icn .Screen/addr DEO2
210
+	#4000
211
+	&ver
212
+		#00 OVR #20 SFT2 .Screen/y DEO2
213
+		STHk
214
+		#4000
215
+		&hor
216
+			#00 OVR #20 SFT2 .Screen/x DEO2
217
+			DUP STHkr get-addr LDA .Screen/sprite DEO
218
+			INC GTHk ?&hor
219
+		POP2
220
+		POPr
221
+		INC GTHk ?&ver
222
+	POP2
223
+
224
+@draw-ui ( -- )
225
+
226
+	( colors )
227
+	#01 .Screen/auto DEO
228
+	#0010 DUP2 .Screen/x DEO2 .Screen/y DEO2
229
+	;color-icn .Screen/addr DEO2
230
+	#01 .Screen/sprite DEO
231
+	#02 .Screen/sprite DEO
232
+	#03 .Screen/sprite DEO
233
+	( toggle )
234
+	#0030 .Screen/x DEO2
235
+	;toggle-icn #00 .timer/play LDZ #30 SFT2 ADD2 .Screen/addr DEO2
236
+	#01 .Screen/sprite DEO
237
+
238
+JMP2r
247 239
 
240
+(
241
+@|assets )
242
+
243
+@pointer-icn [
244
+	80c0 e0f0 f8e0 1000 ]
245
+@cell-icn [
246
+	e0e0 e000 0000 0000 ]
247
+@color-icn [
248
+	7cfe fefe fefe 7c00 ]
249
+@toggle-icn [
250
+	6666 6666 6666 6600
251
+	4666 767e 7666 4600 ]
248 252
 
249 253
 (
250 254
 	I live in the atom with the happy protons and neutrons.
... ...
@@ -253,3 +257,4 @@ JMP2r
253 257
 	How do I find peace? )
254 258
 
255 259
 @world
260
+