-
Notifications
You must be signed in to change notification settings - Fork 2
/
harp.tal
468 lines (420 loc) · 11.8 KB
/
harp.tal
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
|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|30 @Audio0 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
|40 @Audio1 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
|50 @Audio2 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
|60 @Audio3 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
|80 @Controller &vector $2 &button $1 &key $1 &func $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2
|a0 @File0 &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|b0 @File1 &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|c0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1
%Ext { #00 SWP } ( Extend byte to short )
%Mod { DIVk MUL SUB }
%Mod2 { DIV2k MUL2 SUB2 }
%Dbg { #01 .System/debug DEO }
%Ssx { .Screen/x DEO2 }
%Ssy { .Screen/y DEO2 }
%Ssa { .Screen/addr DEO2 }
%Spr { .Screen/sprite DEO }
%Sprr { .Screen/sprite DEOk DEO }
%Sprrr { .Screen/sprite DEOk DEOk DEO }
%Aut0 { #00 .Screen/auto DEO }
%Aut0ay { #06 .Screen/auto DEO }
%Aut1ay { #16 .Screen/auto DEO }
%Aut2ay { #26 .Screen/auto DEO }
%Aut1y { #12 .Screen/auto DEO }
( variables )
|0000
@bass
&which $2 ( A=0, Bb=1, B=2... none=8000 )
&time $2 ( Timer, used for slap + label color update )
@chord
&which $2 ( Current chord index, none=800 )
&time $2 ( Timer, used for arpeggio + volume + label color update )
@on $1 ( for drawing labels )
@pointer &x $2 &y $2 &down $1
( program )
|0100 ( -> )
#8000 DUP2 .bass/which STZ2 .chord/which STZ2
#5f4f .System/r DEO2
#af4e .System/g DEO2
#9f42 .System/b DEO2
#00f8 .Screen/width DEO2
#0068 .Screen/height DEO2
( Bass channel )
#0121 .Audio0/adsr DEO2
#0020 .Audio0/length DEO2
;tri-wave .Audio0/addr DEO2
#ff .Audio0/volume DEO
( Chord channels )
#0010 DUP2 .Audio1/adsr DEO2 .Audio2/adsr DEO2
#0020 DUP2 .Audio1/length DEO2 .Audio2/length DEO2
;tri-wave DUP2 .Audio1/addr DEO2 .Audio2/addr DEO2
#88 DUP .Audio1/volume DEO .Audio2/volume DEO
( Initial draw of chord buttons: )
#0000
&loop-chord
DUP2 #01 ;draw-chord-button JSR2
INC2
DUP2 #000f LTH2 ,&loop-chord JCN
POP2
( Initial draw of bass buttons: )
#0000
&loop-bass
DUP2 #01 ;draw-bass-button JSR2
INC2
DUP2 #000c LTH2 ,&loop-bass JCN
POP2
;on-controller .Controller/vector DEO2
;on-screen .Screen/vector DEO2
;on-mouse .Mouse/vector DEO2
BRK
@bass-keys "vqxdrawcfzse
@chord-keys "yuiophjkl;nm,./
@on-controller ( -> )
( Loop over bass note buttons: )
#0000
&bass-loop
DUP2 ;bass-keys ADD2 LDA
.Controller/key DEI NEQ ,&no-bass JCN
DUP2 ;set-bass JSR2
&no-bass
INC2 DUP2 #000c LTH2 ,&bass-loop JCN
POP2
( Handle space bar = fifth: )
.Controller/key DEI #20 NEQ ,&no-fifth JCN
;pluck-bass JSR2
&no-fifth
( Loop over chord buttons: )
#0000
&chord-loop
DUP2 ;chord-keys ADD2 LDA
.Controller/key DEI NEQ ,&no-chord JCN
DUP2 ;set-chord JSR2
&no-chord
INC2 DUP2 #000f LTH2 ,&chord-loop JCN
POP2
BRK
@set-bass ( note* -> )
.bass/which LDZ2 #00 .on STZ #01 ;draw-bass-button JSR2
.bass/which STZ2
;pluck-bass JSR2
JMP2r
@set-chord ( chord* -> )
.chord/which LDZ2 #00 .on STZ #01 ;draw-chord-button JSR2
.chord/which STZ2 #0010 .chord/time STZ2
DUP2 #01 .on STZ #02 ;draw-chord-button JSR2
JMP2r
@on-mouse
;s1x1_mouse Ssa Aut0
.pointer/x LDZ2 Ssx
.pointer/y LDZ2 Ssy
#40 Spr
.Mouse/x DEI2 DUP2 .pointer/x STZ2 Ssx
.Mouse/y DEI2 DUP2 .pointer/y STZ2 Ssy
#41 Spr
.pointer/down LDZ
.Mouse/state DEI #01 AND DUP .pointer/down STZ
LTH ,&yes-mouse JCN BRK
&yes-mouse
#0000
&loop-bass
( n* )
DUP2 #20 SFT2 ;bass-button-positions ADD2 LDA2k #0003 SUB2 ( n* addr* x* )
.Mouse/x DEI2 SUB2 #ffec LTH2 STH ( n* addr* )
INC2 INC2 LDA2 #0003 SUB2 .Mouse/y DEI2 SUB2 #ffec LTH2 STHr ORA ( n* nomatch )
,&nob JCN DUP2 ;set-bass JSR2 &nob
INC2
DUP2 #000c LTH2 ,&loop-bass JCN
POP2
#0000
&loop-chord
( n* )
DUP2 #20 SFT2 ;chord-button-positions ADD2 LDA2k #0003 SUB2 ( n* addr* x* )
.Mouse/x DEI2 SUB2 #ffec LTH2 STH ( n* addr* )
INC2 INC2 LDA2 #0003 SUB2 .Mouse/y DEI2 SUB2 #ffec LTH2 STHr ORA ( n* nomatch )
,&noc JCN DUP2 ;set-chord JSR2 &noc
INC2
DUP2 #000f LTH2 ,&loop-chord JCN
POP2
BRK
@pluck-bass ( -> )
( Get bass semitones )
.bass/which LDZ2
DUP2 #01 .on STZ #02 ;draw-bass-button JSR2
NIP
( If spacebar was pressed, lower by a fifth: )
.Controller/key DEI #20 EQU
#07
( Subtract 1 (making a tritone) if chords[current][0] == 6 or 8. )
.chord/which LDZ2 #30 SFT ;chords ADD2 LDA
#06 EQUk ROT ROT INC INC EQU EOR SUB
MUL ADD
( Wrap to an octave )
INC INC #0c Mod #37 ADD
.Audio0/pitch DEO
( Set a timer: when time=0e, drop bass pitch by an octave. )
( When time=0a redraw with labelcolor=1 )
#0010 .bass/time STZ2
JMP2r
@get-chord-pitch ( arp-idx* -> midi-pitch )
;chords ADD2 LDA Ext .bass/which LDZ2 ADD2 NIP #0c Mod #45 ADD
JMP2r
@on-screen ( -> )
( Play chord arpeggio: )
.chord/time LDZ2
DUP2 #0000 EQU2 ,&chord-silent JCN
DUP2 #000a NEQ2 ,&no-unflash JCN
.chord/which LDZ2 #01 .on STZ #01 ;draw-chord-button JSR2
&no-unflash
DUP2 NIP #01 AND ,&no-arp JCN
DUP2 #0007 AND2 #01 SFT2
.chord/which LDZ2 #30 SFT2 ADD2
DUP2 ;get-chord-pitch JSR2 .Audio1/pitch DEO
#02 EOR ;get-chord-pitch JSR2 .Audio2/pitch DEO
&no-arp
DUP2 NIP #01 SUB #40 SFT .Audio1/volume DEO
DUP2 NIP #01 SUB .Audio2/volume DEO
DUP2 #0001 SUB2 .chord/time STZ2
&chord-silent
POP2
.bass/time LDZ2
DUP2 #0000 EQU2 ,&bass-silent JCN
#0001 SUB2 DUP2 .bass/time STZ2
DUP2 #000e NEQ2 ,&no-slap-effect JCN
.Audio0/pitch DEI #0c SUB .Audio0/pitch DEO
&no-slap-effect
DUP2 #000a NEQ2 ,&no-unflash-bass JCN
.bass/which LDZ2 #01 .on STZ #01 ;draw-bass-button JSR2
&no-unflash-bass
&bass-silent
POP2
BRK
@chord-button-positions
( array of 15 x/y pairs )
$4 $4 $4 $4 $4
$4 $4 $4 $4 $4
$4 $4 $4 $4 $4
@draw-chord-button ( num* labelcolor -> )
STH
( Redraw the button for the num-th chord. )
( x = 0x80 + num%5 * 0x18 )
DUP2 #0005 Mod2 #0018 MUL2 #0080 ADD2 ( num* x* )
( y = 0x08 + num/5 * 0x18 )
OVR2 #0005 DIV2 #0018 MUL2 #0008 ADD2 ( num* x* y* )
( Store this button position for mouse input: )
ROT2k #20 SFT2 ;chord-button-positions ADD2 ( num* x* y* x* y* xaddr )
ROT2 SWP2 STA2k NIP2 ( num* x* y* y* xaddr )
INC2 INC2 STA2 ( num* x* y* )
OVR2 OVR2 ;draw-border JSR2
Ssy SWP2 ( x* num* )
#30 SFT2 ( x* 8num* )
Aut0ay ( x* 8num* )
;chords/l ADD2 ( x* &lsprt )
INC2k INC2 LDA2 ( x* &lsprt rsprt )
DUP2 #0000 EQU2 ,&no-right JCN
( Draw the right 1x2 sprite at [x+8,y]. )
Ssa ( x* &lsprt )
OVR2 #0008 ADD2 Ssx ( x* &lsprt )
STHrk Sprr ( x* &lsprt )
.Screen/y DEI2 #0010 SUB2 Ssy
,&draw-left JMP
&no-right
( If no right, draw left centered, at [x+4,y] )
POP2 SWP2 #0004 ADD2 SWP2
&draw-left
LDA2 Ssa
Ssx
STHr Sprr
JMP2r
@bass-button-positions
( array of 12 x/y pairs )
$4 $4 $4 $4
$4 $4 $4 $4
$4 $4 $4 $4
@draw-bass-button ( num* labelcol -> )
STH
DUP2 #8000 NEQ2 ,¬-none JCN STHr POP POP2 JMP2r ¬-none
( Draw the note button for semitone num )
( x = 0x08 + 0x18 * [n+3&3] )
( y = 0x08 + 0x18 * [[n+11^3]%3]... don't ask )
DUP2 #0003 ADD2 #0003 AND2 #0018 MUL2 #0008 ADD2
OVR2 #000b ADD2 #0003 EOR2 #0003 Mod2 #0018 MUL2 #0008 ADD2
( num* x* y* )
( Store this button position for mouse input: )
ROT2k #20 SFT2 ;bass-button-positions ADD2 ( num* x* y* x* y* xaddr )
ROT2 SWP2 STA2k NIP2 ( num* x* y* y* xaddr )
INC2 INC2 STA2 ( num* x* y* )
OVR2 OVR2 ;draw-border JSR2 ( num* x* y* )
Ssy SWP2 #50 SFT2 ;s2x2_note ADD2 DUP2 Ssa ( x* addr )
( Draw 1px to the right if the sprite has an accidental, detected as spr[8] != 0: )
#0008 ADD2 LDA #00 EQU Ext ADD2 Ssx ( )
Aut1ay STHr Sprr
JMP2r
@draw-border ( x* y* -> )
#0002 SUB2 Ssy
#0002 SUB2 Ssx
;s3x3_border Ssa
Aut2ay
#02 .on LDZ SUB Sprrr
JMP2r
@chords
( notes left sprt right sprt )
07 0b 0e 10 &l :s1x2_maj7 :s1x2_9
07 0a 0e 0f :s1x2_m :s1x2_9
07 0a 0c 11 :s1x2_7 :s1x2_s
07 0a 0d 10 :s1x2_7 :s1x2_flat9
0a 0e 11 15 :s1x2_13 :s1x2_s
07 0b 0c 10 :s1x2_maj7 0000
07 0a 0c 0f :s1x2_m :s1x2_7
07 0a 0c 10 :s1x2_7 0000
08 0a 0c 10 :s1x2_7 :s1x2_sharp5
0a 0e 10 15 :s1x2_13 0000
07 09 0c 10 :s1x2_6 0000
07 09 0c 0f :s1x2_m :s1x2_6
06 0a 0c 0f :s1x2_sdim :s1x2_7
06 09 0c 0f :s1x2_dim :s1x2_7
09 0e 0c 12 :s1x2_iil :s1x2_iir
@note-table
:s2x2_note/a :s1x1_blank
:s2x2_note/bb :s1x1_blank
:s2x2_note/b :s1x1_blank
:s2x2_note/c :s1x1_blank
:s2x2_note/db :s1x1_blank
:s2x2_note/d :s1x1_blank
:s2x2_note/eb :s1x1_blank
:s2x2_note/e :s1x1_blank
:s2x2_note/f :s1x1_blank
:s2x2_note/fs :s1x1_blank
:s2x2_note/g :s1x1_blank
:s2x2_note/ab :s1x1_blank
@s2x2_note
&a
0000 0203 0705 0908
0000 0000 0080 80c0
1010 3f20 4040 e000
c060 e030 3018 3c00
&bb
0000 ff61 6060 6061
0808 0e8a cacc 8800
7f61 6060 6061 ff00
0080 c0c0 c080 0000
&b
0000 ff61 6060 6061
0000 0080 c0c0 8000
7f61 6060 6061 ff00
0080 c0c0 c080 0000
&c
0000 1f30 60c0 c0c0
0000 e0e0 6060 0000
c0c0 c0c0 6030 1f00
0000 0000 60c0 8000
&db
0000 ff61 6060 6060
0808 0e8a ca6c 6860
6060 6060 6061 ff00
6060 6060 c080 0000
&d
0000 ff61 6060 6060
0000 0080 c060 6060
6060 6060 6061 ff00
6060 6060 c080 0000
&eb
0000 ff60 6060 6061
0808 ee6a 0a0c 0800
7f61 6060 6060 ff00
0000 0000 0060 e000
&e
0000 ff60 6060 6061
0000 e060 0000 0000
7f61 6060 6060 ff00
0000 0000 0060 e000
&f
0000 ff60 6060 6061
0000 e060 0000 0000
7f61 6060 6060 f000
0000 0000 0000 0000
&fs
0000 ff60 6060 6061
0a1f ea6a 1f0a 0000
7f61 6060 6060 f000
0000 0000 0000 0000
&g
0000 1f30 60c0 c0c0
0000 e0e0 6060 0000
c0c1 c0c0 6030 1f00
00f0 6060 60e0 6000
&ab
0000 0203 0705 0908
0808 0e0a 0a8c 88c0
1010 3f20 4040 e000
c060 e030 3018 3c00
@s1x2_7
0000 0000 7e46 060c
0c18 1830 3000 0000
@s1x2_13
0000 0000 dfc2 c6cc
dec3 c3c6 dc00 0000
@s1x2_sharp5
0057 f456 51f1 5600
0000 0000 0000 0000
@s1x2_flat9
0046 4575 5361 4600
0000 0000 0000 0000
@s1x2_maj7
0000 0000 1818 3c3c
6666 c3c3 ff00 0000
@s1x2_9
0000 0000 3c66 6666
3e06 060c 7800 0000
@s1x2_m
0000 0000 0000 00b6
dbdb dbdb db00 0000
@s1x2_sdim
0000 0003 1e37 3f3b
1e30 0000 0000 0000
@s1x2_dim
0000 0000 1e33 3333
1e00 0000 0000 0000
@s1x2_6
0000 0000 1e30 6060
7c66 6666 3c00 0000
@s1x2_s
0000 0000 0000 3e62
603c 0646 7c00 0000
@s1x2_iil
0000 0000 7f33 3333
3333 3333 7f00 0000
@s1x2_iir
0000 0006 860c 0c0c
1818 1830 b030 0000
@s3x3_border
3f40 8080 8080 8080
ff00 0000 0000 0000
c020 1010 1010 1010
8080 8080 8080 8080
@s1x1_blank 0000 0000 0000 0000
1010 1010 1010 1010
8080 403f 0000 0000
0000 00ff 0000 0000
1010 20c0 0000 0000
@s1x1_mouse
80c0 e0f0 c020 0000
@saw-wave
80 88 90 98 a0 a8 b0 b8 c0 c8 d0 d8 e0 e8 f0 f8
00 08 10 18 20 28 30 38 40 48 50 58 60 68 70 78
@tri-wave
80 90 a0 b0 c0 d0 e0 f0 ff f0 e0 d0 c0 b0 a0 90
80 70 60 50 40 30 20 10 00 10 20 30 40 50 60 70
@s1x2_note
&a 0000 003e 6363 637f 6363 6363 0000 0000
&b 0000 007e 6363 637e 6363 637e 0000 0000
&c 0000 003e 6360 6060 6060 633e 0000 0000
&d 0000 007c 6663 6363 6363 667c 0000 0000
&e 0000 007e 6060 607c 6060 607e 0000 0000
&f 0000 007e 6060 607c 6060 6060 0000 0000
&g 0000 003e 6360 606f 6363 633e 0000 0000
&flat 0000 2020 3828 2830 2000 0000 0000 0000
&sharp 0000 50f8 5050 f850 0000 0000 0000 0000