~rabbits/orca-toy

ref: c188e2b30382c196dd85f2d7a9b18394c26fc909 orca-toy/src/library.tal -rw-r--r-- 16.7 KiB
c188e2b3Devine Lu Linvega Optimized H 3 months ago
                                                                                
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
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
@op-table
	&docs
	:op-a/? :op-b/? :op-c/? :op-d/? :op-e/? :op-f/? :op-g/? :op-h/?
	:op-i/? :op-j/? :op-k/? :op-l/? :op-m/? :op-n/? :op-o/? :op-p/?
	:op-q/? :op-r/? :op-s/? :op-t/? :op-u/? :op-v/? :op-w/? :op-x/?
	:op-y/? :op-z/?
	:op-bang/? :op-comment/? :op-synth/? :op-midi/? :op-pitch/? :op-byte/? :op-self/?

@op-a-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-a ( add )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( a-val ) #0001 SUB2 ;get-port-left-value JSR2
	( b-raw ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2
	( res ) ADD
	( set case ) [ LIT &case $1 ] ;set-case JSR2
	( output ) STH2r ;set-port-output-below ( .. )

JMP2
	&? 'A "Outputs 20 "sum 20 "of 20 "inputs $1

@op-b-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-b ( subtract )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get a ) #0001 SUB2 ;get-port-left-value JSR2
	( get b ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2
	( res ) SUB DUP #80 LTH ,&bounce JCN #24 SWP SUB &bounce
	( set case ) [ LIT &case $1 ] ;set-case JSR2
	( output ) STH2r ;set-port-output-below ( .. )

JMP2
	&? 'B "Outputs 20 "difference 20 "of 20 "inputs $1

@op-c-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-c ( clock )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get rate ) #0001 SUB2 ;get-port-left-value JSR2 DUP #00 EQU ADD
	( get mod ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2 DUP #00 EQU ADD
	( res ) #00 SWP ROT #00 SWP .timer/frame LDZ2 SWP2 DIV2 SWP2 ( MOD2 ) [ DIV2k MUL2 SUB2 ] NIP
	( set case ) [ LIT &case $1 ] ;set-case JSR2
	( output ) STH2r ;set-port-output-below ( .. )

JMP2
	&? 'C "Outputs 20 "modulo 20 "of 20 "frame $1

@op-d-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-d ( delay )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get rate ) #0001 SUB2 ;get-port-left-value JSR2 DUP #00 EQU ADD
	( get mod ) STH2kr INC2 ;get-port-right-value JSR2 DUP #00 EQU ADD
	( res ) MUL #00 SWP .timer/frame LDZ2 SWP2 ( MOD2 ) [ DIV2k MUL2 SUB2 ] #0000 EQU2
	( bang on equal ) #fc MUL LIT '. ADD
	( output ) STH2r ;set-port-output-below ( .. )

JMP2
	&? 'D "Bangs 20 "on 20 "modulo 20 "of 20 "frame $1

@op-e-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-e ( east )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	;data/cells ADD2 LDA ,&self STR
	( wall ) .head/x LDZ INC .grid/width LDZ EQU ,&collide JCN
	( cell ) STH2kr INC2 ;data/cells ADD2 LDA LIT '. NEQ ,&collide JCN
	( write new ) [ LIT &self $1 ] STH2kr INC2 ;set-port-raw JSR2
	( erase old ) LIT '. STH2r ;set-port-raw JMP2
	&collide
	( output ) LIT '* STH2r ;set-port-output ( .. )

JMP2
	&? 'E "Moves 20 "eastward 20 "or 20 "bangs $1

@op-f-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-f ( if )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get a ) #0001 SUB2 ;get-port-left-raw JSR2
	( get b ) STH2kr INC2 ;get-port-right-raw JSR2
	( bang on equal ) EQU [ #fc MUL LIT '. ADD ]
	( output ) STH2r ;set-port-output-below ( .. )

JMP2
	&? 'F "Bangs 20 "if 20 "inputs 20 "are 20 "equal $1

@op-g-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-g ( generator )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( x ) STH2kr #0003 SUB2 ;get-port-left-value JSR2
		( load ) #00 SWP ADD2
	( y ) STH2kr #0002 SUB2 ;get-port-left-value JSR2
		( load ) #00 SWP INC2 [ #00 .grid/width LDZ MUL2 ] ADD2
	,&save STR2
	( len ) STH2kr #0001 SUB2 ;get-port-left-value JSR2 DUP #00 EQU ADD
	#00
	&loop
		( load ) #00 OVR STH2kr INC2 ADD2 ;get-port-right-raw JSR2
		( save ) OVR #00 SWP [ LIT2 &save $2 ] ADD2 ;set-port-output JSR2
		INC GTHk ,&loop JCN
	POP2
	POP2r

JMP2r
	&? 'G "Writes 20 "operands 20 "with 20 "offset $1

@op-h-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-h ( hold )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get cell ) #00 .grid/width LDZ ADD2 ;data/cells ADD2 LDA
	( output ) STH2r ;set-port-output-below ( .. )

JMP2
	&? 'H "Holds 20 "southward 20 "operand $1

@op-i-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-i ( increment )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( step ) #0001 SUB2 ;get-port-left-value JSR2
	( mod ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2 DUP #00 EQU ADD
	( res ) SWP STH2kr #00 .grid/width LDZ ADD2 [ ;data/cells ADD2 LDA ;chrb36 JSR2 ] ADD SWP ( MOD ) [ DIVk MUL SUB ]
	( set case ) [ LIT &case $1 ] ;set-case JSR2
	( output ) STH2r ;set-port-output-below ( .. )

JMP2
	&? 'I "Increments 20 "southward 20 "operand $1

@op-j-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-j ( jumper )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get above ) #00 .grid/width LDZ SUB2 ;get-port-left-raw JSR2
	( ignore cable )
	DUP ;chrb36 JSR2 #13 NEQ ,&no-wire JCN
		POP POP2r JMP2r &no-wire
	( skip down )
	STH2r
	&while
		#00 .grid/width LDZ ADD2 DUP2 ;data/cells ADD2 LDA ;chrb36 JSR2 #13 EQU
		,&while JCN
	( set below ) ;set-port-output ( .. )

JMP2
	&? 'J "Outputs 20 "northward 20 "operand $1

@op-k-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-k ( konkat )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	#0001 SUB2 ;get-port-left-value JSR2 #00
	&loop
		#00 OVR STH2kr INC2 ADD2 STH2k ;get-port-right-raw JSR2
		DUP LIT '. EQU ,&skip JCN
			( load ) DUP ;chrb36 JSR2 .variables ADD LDZ
			( save ) STH2kr #00 .grid/width LDZ ADD2 ;set-port-output JSR2
			&skip
		POP
		POP2r
		INC GTHk ;&loop JCN2
	POP2
	POP2r

JMP2r
	&? 'K "Reads 20 "multiple 20 "variables $1

@op-l-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-l ( lesser )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get a ) #0001 SUB2 ;get-port-left-value JSR2
	( get b ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2
	( res ) [ LTHk JMP SWP POP ]
	( set case ) [ LIT &case $1 ] ;set-case JSR2
	( output ) STH2r ;set-port-output-below ( .. )

JMP2
	&? 'L "Outputs 20 "smallest 20 "of 20 "inputs $1

@op-m-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-m ( multiply )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get a ) #0001 SUB2 ;get-port-left-value JSR2
	( get b ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2
	( res ) MUL
	( set case ) [ LIT &case $1 ] ;set-case JSR2
	( output ) STH2r ;set-port-output-below ( .. )

JMP2
	&? 'M "Outputs 20 "product 20 "of 20 "inputs $1

@op-n-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-n ( north )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	;data/cells ADD2 LDA ,&self STR
	( wall ) .head/y LDZ #01 SUB #ff EQU ,&collide JCN
	( cell ) STH2kr #00 .grid/width LDZ SUB2 ;data/cells ADD2 LDA LIT '. NEQ ,&collide JCN
	( write new ) [ LIT &self $1 ] STH2kr #00 .grid/width LDZ SUB2 ;set-port-raw JSR2
	( erase old ) LIT '. STH2r ;set-port-raw JMP2
	&collide
	( output ) LIT '* STH2r ;set-port-output ( .. )

JMP2
	&? 'N "Moves 20 "Northward 20 "or 20 "bangs $1

@op-o-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-o ( read )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( x ) STH2kr #0002 SUB2 ;get-port-left-value JSR2 INC #00 SWP ADD2
	( y ) STH2kr #0001 SUB2 ;get-port-left-value JSR2 #00 SWP #00 .grid/width LDZ MUL2 ADD2
	( val ) ;get-port-right-raw JSR2
	( output ) STH2r ;set-port-output-below ( .. )

JMP2
	&? 'O "Reads 20 "operand 20 "with 20 "offset $1

@op-p-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-p ( push )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( key ) #0002 SUB2 ;get-port-left-value JSR2
	( len ) STH2kr #0001 SUB2 ;get-port-left-value JSR2 DUP #00 EQU ADD
	#00
	&loop
		#00 OVR STH2kr #00 .grid/width LDZ ADD2 ADD2 STH2
		( lock ) #01 STH2kr ;data/locks ADD2 STA
		( type ) .types/locked STH2r ;data/types ADD2 STA
		INC GTHk ,&loop JCN
	POP
	( read ) STH2kr INC2 ;get-port-right-raw JSR2
	( output ) ROT ROT ( MOD ) [ DIVk MUL SUB ] #00 SWP STH2r #00 .grid/width LDZ ADD2 ADD2
		;set-port-output ( .. )

JMP2
	&? 'P "Writes 20 "eastward 20 "operand $1

@op-q-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-q ( query )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( x ) STH2kr #0003 SUB2 ;get-port-left-value JSR2
		( load ) #00 SWP INC2 ADD2
	( y ) STH2kr #0002 SUB2 ;get-port-left-value JSR2
		( load ) #00 SWP [ #00 .grid/width LDZ MUL2 ] ADD2
	,&load STR2
	( len ) STH2kr #0001 SUB2 ;get-port-left-value JSR2 DUP #00 EQU ADD
		( save ) #00 OVR STH2kr #00 .grid/width LDZ ADD2 SWP2 SUB2 INC2 ,&save STR2
	#00
	&loop
		( load ) #00 OVR [ LIT2 &load $2 ] ADD2 ;get-port-right-raw JSR2
		( save ) OVR #00 SWP [ LIT2 &save $2 ] ADD2 ;set-port-output JSR2
		INC GTHk ,&loop JCN
	POP2
	POP2r

JMP2r
	&? 'Q "Reads 20 "operands 20 "with 20 "offset $1

@op-r-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-r ( random )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( a-min ) #0001 SUB2 ;get-port-left-value JSR2
	( b-max ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2 DUP #00 EQU ADD
	( mod ) OVR SUB ;prng JSR2 ADD SWP DUP #00 EQU ADD ( MOD ) [ DIVk MUL SUB ] ADD
	( set case ) [ LIT &case $1 ] ;set-case JSR2
	( output ) STH2r ;set-port-output-below ( .. )

JMP2
	&? 'R "Outputs 20 "random 20 "value $1

@op-s-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-s ( south )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	;data/cells ADD2 LDA ,&self STR
	( wall ) .head/y LDZ INC .grid/height LDZ EQU ,&collide JCN
	( cell ) STH2kr #00 .grid/width LDZ ADD2 ;data/cells ADD2 LDA LIT '. NEQ ,&collide JCN
	( write new ) [ LIT &self $1 ] STH2kr #00 .grid/width LDZ ADD2 ;set-port-raw JSR2
	( erase old ) LIT '. STH2r ;set-port-raw JMP2
	&collide
	( output ) LIT '* STH2r ;set-port-output ( .. )

JMP2
	&? 'S "Moves 20 "southward 20 "or 20 "bangs $1

@op-t-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-t ( track )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( key ) #0002 SUB2 ;get-port-left-value JSR2
	( len ) STH2kr #0001 SUB2 ;get-port-left-value JSR2 DUP #00 EQU ADD
	#00
	&loop
		#00 OVR STH2kr INC2 ADD2 STH2
		( lock ) #01 STH2kr ;data/locks ADD2 STA
		( type ) .types/locked STH2r ;data/types ADD2 STA
		INC GTHk ,&loop JCN
	POP
	( read ) ( MOD ) [ DIVk MUL SUB ] #00 SWP STH2kr INC2 ADD2 ;get-port-right-raw JSR2
	( output ) STH2r ;set-port-output-below ( .. )

JMP2
	&? 'T "Reads 20 "eastward 20 "operand $1

@op-u-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-u ( Uclid )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( step ) #0001 SUB2 ;get-port-left-value JSR2
	( max ) STH2kr INC2 ;get-port-right-value JSR2 DUP #00 EQU ADD STH2
	( frame ADD max SUB 1 ) .timer/frame LDZ2 STHkr #00 SWP ADD2 #0001 SUB2
	( MUL step ) OVRr STHr #00 SWP MUL2
	( % max ) STHkr #00 SWP ( MOD2 ) [ DIV2k MUL2 SUB2 ]
	( ADD step ) SWPr STHr #00 SWP ADD2
	( bucket GTH= max ) STHr #00 SWP LTH2 #01 NEQ
	( bang if equal ) #fc MUL LIT '. ADD
	( output ) STH2r ;set-port-output-below ( .. )

JMP2
	&? 'U "Bangs 20 "on 20 "Euclidean 20 "rhythm $1

@op-v-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-v ( variable )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( key ) #0001 SUB2 ;get-port-left-raw JSR2
	( val ) STH2kr INC2 ;get-port-right-raw JSR2
	DUP LIT '. EQU ,&idle JCN
	OVR ;chrb36 JSR2 ,&save JCN
	( load )
		NIP ;chrb36 JSR2 .variables ADD LDZ STH2r #00 .grid/width LDZ ADD2 ;set-port-output JMP2
	&save
		SWP ;chrb36 JSR2 .variables ADD STZ POP2r JMP2r
	&idle
		POP2 POP2r

JMP2r
	&? 'V "Reads 20 "and 20 "writes 20 "variable $1

@op-w-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-w ( west )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	;data/cells ADD2 LDA ,&self STR
	( wall ) .head/x LDZ #01 SUB #ff EQU ,&collide JCN
	( cell ) STH2kr #0001 SUB2 ;data/cells ADD2 LDA LIT '. NEQ ,&collide JCN
	( write new ) [ LIT &self $1 ] STH2kr #0001 SUB2 ;set-port-raw JSR2
	( erase old ) LIT '. STH2r ;set-port-raw JMP2
	&collide
	( output ) LIT '* STH2r ;set-port-output ( .. )

JMP2
	&? 'W "Moves 20 "westward 20 "or 20 "bangs $1

@op-x-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-x ( write )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( x ) STH2kr #0002 SUB2 ;get-port-left-value JSR2 #00 SWP ADD2
	( y ) STH2kr #0001 SUB2 ;get-port-left-value JSR2 INC #00 SWP #00 .grid/width LDZ MUL2 ADD2
	( val ) STH2r INC2 ;get-port-right-raw JSR2
	( output ) ROT ROT ;set-port-output ( .. )

JMP2
	&? 'X "Writes 20 "operand 20 "with 20 "offset $1

@op-y-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-y ( yumper )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get above ) #0001 SUB2 ;get-port-left-raw JSR2
	( ignore cable )
	DUP ;chrb36 JSR2 #22 NEQ ,&no-wire JCN
		POP POP2r JMP2r &no-wire
	( skip down )
	STH2r
	&while
		INC2 DUP2 ;data/cells ADD2 LDA ;chrb36 JSR2 #22 EQU
		,&while JCN
	( set below ) ;set-port-output ( .. )

JMP2
	&? 'Y "Outputs 20 "westward 20 "operand $1

@op-z-lc ;get-bang JSR2 ,&* JCN POP2 JMP2r &*
@op-z ( lerp )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( rate ) #0001 SUB2 ;get-port-left-value JSR2
	( target ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2
	( val ) STH2kr #00 .grid/width LDZ ADD2 [ ;data/cells ADD2 LDA ;chrb36 JSR2 ]
	( res ) ;lerp JSR2
	( set case ) [ LIT &case $1 ] ;set-case JSR2
	( output ) STH2r ;set-port-output-below ( .. )

JMP2
	&? 'Z "Transitions 20 "operand 20 "to 20 "input $1

( special )

@op-bang ( bang )

	LIT '. ROT ROT ;data/cells ADD2 STA

JMP2r
	&? '* "Bangs 20 "neighboring 20 "operands $1

@op-comment ( comment )

	STH2k
	( bounds )
	#00 .grid/width LDZ .head/x LDZ SUB ADD2
	STH2r INC2
	&loop
		( set lock ) DUP2 #01 ROT ROT ;data/locks ADD2 STA
		( set type if unset )
		DUP2 ;data/types ADD2 LDA ,&skip JCN
			( set type ) DUP2 .types/locked ROT ROT ;data/types ADD2 STA
			&skip
		( stop at hash ) DUP2 ;data/cells ADD2 LDA LIT '# EQU ,&end JCN
		INC2 GTH2k ,&loop JCN
	&end
	POP2 POP2

JMP2r
	&? '# "Comments 20 "a 20 "line $1

@op-synth ( synth )

	STH2k
	( channel ) INC2 ;get-port-right-value JSR2 [ ,&ch STR ]
	( octave ) STH2kr INC2 INC2 ;get-port-right-value JSR2
	( note ) STH2kr #0003 ADD2 ;get-port-right-raw JSR2
	( has note ) DUP LIT '. NEQ ,&has-note JCN [ POP2 POP2r JMP2r ] &has-note
	( has bang ) ;get-bang JSR2 ,&is-bang JCN [ POP2 POP2r JMP2r ] &is-bang
	( animate ) .types/io STH2r ;data/types ADD2 STA
	( get note ) ;chrmid JSR2 SWP [ #0c MUL ] ADD
	( play ) .Audio0/pitch [ LIT &ch $1 ] #03 AND #40 SFT ADD DEO

JMP2r
	&? '= "Play 20 "note 20 "with 20 "uxn 20 "synth $1

@op-midi ( midi )

	STH2k
	( channel ) INC2 ;get-port-right-value JSR2 [ ,&ch STR ]
	( octave ) STH2kr INC2 INC2 ;get-port-right-value JSR2
	( note ) STH2kr #0003 ADD2 ;get-port-right-raw JSR2
	( velocity ) STH2kr #0004 ADD2 ;get-port-right-raw JSR2 [ ,&vel STR ]
	( length ) STH2kr #0005 ADD2 ;get-port-right-value JSR2

	( has note ) OVR LIT '. NEQ ,&has-note JCN [ POP POP2 POP2r JMP2r ] &has-note
	( has bang ) ;get-bang JSR2 ,&is-bang JCN [ POP POP2 POP2r JMP2r ] &is-bang

	( store length ) .voices ,&ch LDR DUP ADD ADD INC STZk POP [ ,&len STR ]

	( animate ) .types/io STH2r ;data/types ADD2 STA

	( get note ) ;chrmid JSR2 SWP [ #0c MUL ] ADD
	( store note ) DUP .voices ,&ch LDR DUP ADD ADD STZ
	( get velocity ) [ LIT &vel $1 ]
		DUP LIT '. NEQ ,&normalize JCN
			( default to max ) POP #7f ,&continue JMP
		&normalize
		;base128 JSR2 &continue SWP
	( get channel ) [ LIT &ch $1 ]

	( note on )
	( channel ) DUP .Console/write DEO
	( note ) OVR .Console/write DEO
	( velocity ) ROT .Console/write DEO

	.signal/midi LDZk INC SWP STZ

	( note off immediately if 0 length )
	[ LIT &len $1 ] #00 NEQ ,&done JCN
		( channel ) .Console/write DEO
		( note ) .Console/write DEO
		( off ) #00 .Console/write DEO
		JMP2r
	&done
	POP2

JMP2r
	&? ': "Send 20 "a 20 "midi 20 "note $1

@op-pitch ( pitch )

	STH2k
	( octave ) INC2 ;get-port-right-value JSR2
	( note ) STH2kr INC2 INC2 ;get-port-right-raw JSR2
	( has note ) DUP LIT '. NEQ ,&has-note JCN [ POP2 POP2r JMP2r ] &has-note
	( has bang ) ;get-bang JSR2 ,&is-bang JCN [ POP2 POP2r JMP2r ] &is-bang
	( animate ) .types/io STH2r ;data/types ADD2 STA
	( get note ) ;chrmid JSR2 SWP [ #0c MUL ] ADD .Console/write DEO

JMP2r
	&? '; "Send 20 "a 20 "raw 20 "pitch 20 "byte $1

@op-byte ( byte )

	STH2k
	( hn ) INC2 ;get-port-right-value JSR2
	( ln ) STH2kr INC2 INC2 ;get-port-right-value JSR2
	( has bang ) ;get-bang JSR2 ,&is-bang JCN [ POP2 POP2r JMP2r ] &is-bang
	( animate ) .types/io STH2r ;data/types ADD2 STA
	#0f AND SWP #0f AND #40 SFT ADD .Console/write DEO

JMP2r
	&? '/ "Send 20 "a 20 "raw 20 "hexadecimal 20 "byte $1

@op-self ( self )

	STH2k
	&while
		INC2 DUP2 ;get-port-right-raw JSR2 LIT '. NEQ ,&while JCN
	POP2
	( has bang ) ;get-bang JSR2 ,&is-bang JCN [ POP2r JMP2r ] &is-bang
	.head LDZ2 INC STH2kr ;get-word JSR2 ;inject-file JSR2
	( animate ) .types/io STH2r ;data/types ADD2 STA

JMP2r
	&? '$ "Load 20 "orca 20 "file $1

@op-null ( null )

	POP2

JMP2r