1( Piano:
2 Play notes with the keyboard or the controller )
3
4|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
5|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
6|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
7|30 @Audio0 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
8|40 @Audio1 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
9|80 @Controller &vector $2 &button $1 &key $1
10|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &modx $2 &mody $2
11
12%HALT { #010f DEO }
13
14|0000
15
16 @octave $1
17 @center &x $2 &y $2
18 @adsr-view &x1 $2 &y1 $2 &x2 $2 &y2 $2
19 @wave-view &x1 $2 &y1 $2 &x2 $2 &y2 $2
20 @octave-view &x1 $2 &y1 $2 &x2 $2 &y2 $2
21
22|0100 ( -> )
23
24 ( theme )
25 #0fe3 .System/r DEO2
26 #0fc3 .System/g DEO2
27 #0f23 .System/b DEO2
28 ( resize )
29 #0180 .Screen/width DEO2
30 #00e0 .Screen/height DEO2
31 ( find center )
32 .Screen/width DEI2 #01 SFT2
33 DUP2 .center/x STZ2
34 #0080 SUB2
35 DUP2 .octave-view/x1 STZ2
36 #0050 ADD2 .octave-view/x2 STZ2
37 .Screen/height DEI2 #01 SFT2 #0010 ADD2
38 DUP2 .center/y STZ2
39 #0010 ADD2
40 DUP2 .octave-view/y1 STZ2
41 #0018 ADD2 .octave-view/y2 STZ2
42 ( place adsr )
43 .center/x LDZ2 #0020 SUB2 .adsr-view/x1 STZ2
44 .center/y LDZ2 #0010 ADD2 .adsr-view/y1 STZ2
45 .adsr-view/x1 LDZ2 #00a0 ADD2 .adsr-view/x2 STZ2
46 .adsr-view/y1 LDZ2 #0018 ADD2 .adsr-view/y2 STZ2
47 ( place waveform )
48 .center/x LDZ2 #0080 SUB2 .wave-view/x1 STZ2
49 .center/y LDZ2 #0040 SUB2 .wave-view/y1 STZ2
50 .wave-view/x1 LDZ2 #0100 ADD2 .wave-view/x2 STZ2
51 .wave-view/y1 LDZ2 #0040 ADD2 .wave-view/y2 STZ2
52 ( setup synth )
53 #041c set-env
54 #dd set-vol
55 ;sin-pcm .Audio0/addr DEO2
56 ;sin-pcm .Audio1/addr DEO2
57 #0100
58 DUP2 .Audio0/length DEO2
59 .Audio1/length DEO2
60 ( inital drawing )
61 draw-octave
62 draw-adsr
63 draw-wave
64 ( unlock )
65 ;on-frame .Screen/vector DEO2
66 ;on-control .Controller/vector DEO2
67 ;on-mouse .Mouse/vector DEO2
68 ;on-message .Console/vector DEO2
69
70BRK
71
72(
73@|vectors )
74
75@on-frame ( -> )
76
77 .Mouse/state DEI ?&skip-sft
78 [ LIT2 00 &soft $1 ] EQUk ?&no-soft
79 soften
80 DUP #01 SUB ,&soft STR
81 &no-soft
82 POP2
83 &skip-sft
84
85 [ LIT &last $1 ] .Audio0/output DEI NEQk ?&changed
86 POP2 BRK
87 &changed
88 ,&last STR POP
89
90 ( redraw )
91 [ LIT2 00 -Screen/auto ] DEO
92 .adsr-view/y2 LDZ2 #0020 SUB2 .Screen/y DEO2
93 #1000
94 &loop
95 .adsr-view/x2 LDZ2 #003a SUB2 .Screen/x DEO2
96 #10 OVR SUB .Audio0/output DEI
97 DUP2 #0f AND LTH .Screen/pixel DEO
98 .Screen/x DEI2k INC2 INC2 ROT DEO2
99 #04 SFT LTH .Screen/pixel DEO
100 .Screen/y DEI2k INC2 INC2 ROT DEO2
101 INC GTHk ?&loop
102 POP2
103
104BRK
105
106@on-control ( -> )
107
108 .Controller/key DEI
109 ( octave )
110 [ LIT "a ] NEQk NIP ?&no-c #30 .octave LDZ #0c MUL ADD play &no-c
111 [ LIT "w ] NEQk NIP ?&no-c# #31 .octave LDZ #0c MUL ADD play &no-c#
112 [ LIT "s ] NEQk NIP ?&no-d #32 .octave LDZ #0c MUL ADD play &no-d
113 [ LIT "e ] NEQk NIP ?&no-d# #33 .octave LDZ #0c MUL ADD play &no-d#
114 [ LIT "d ] NEQk NIP ?&no-e #34 .octave LDZ #0c MUL ADD play &no-e
115 [ LIT "f ] NEQk NIP ?&no-f #35 .octave LDZ #0c MUL ADD play &no-f
116 [ LIT "t ] NEQk NIP ?&no-f# #36 .octave LDZ #0c MUL ADD play &no-f#
117 [ LIT "g ] NEQk NIP ?&no-g #37 .octave LDZ #0c MUL ADD play &no-g
118 [ LIT "y ] NEQk NIP ?&no-g# #38 .octave LDZ #0c MUL ADD play &no-g#
119 [ LIT "h ] NEQk NIP ?&no-a #39 .octave LDZ #0c MUL ADD play &no-a
120 [ LIT "u ] NEQk NIP ?&no-a# #3a .octave LDZ #0c MUL ADD play &no-a#
121 [ LIT "j ] NEQk NIP ?&no-b #3b .octave LDZ #0c MUL ADD play &no-b
122 [ LIT "k ] NEQk NIP ?&no-c2 #3c .octave LDZ #0c MUL ADD play &no-c2
123 ( controls )
124 [ LIT "z ] NEQk NIP ?&no-dec .octave LDZk #01 SUB SWP STZ &no-dec
125 [ LIT "x ] NEQk NIP ?&no-inc .octave LDZk INC SWP STZ &no-inc
126 [ #1b ] NEQk NIP ?&no-esc HALT &no-esc
127 POP
128
129 ( release )
130 #00 .Controller/key DEO
131
132 .Controller/button DEI
133 [ #11 ] NEQk NIP ?&cu #3c play &cu
134 [ #21 ] NEQk NIP ?&cd #3d play &cd
135 [ #41 ] NEQk NIP ?&cl #3e play &cl
136 [ #81 ] NEQk NIP ?&cr #3f play &cr
137 [ #12 ] NEQk NIP ?&au #40 play &au
138 [ #22 ] NEQk NIP ?&ad #41 play &ad
139 [ #42 ] NEQk NIP ?&al #42 play &al
140 [ #82 ] NEQk NIP ?&ar #43 play &ar
141 [ #14 ] NEQk NIP ?&su #44 play &su
142 [ #24 ] NEQk NIP ?&sd #45 play &sd
143 [ #44 ] NEQk NIP ?&sl #46 play &sl
144 [ #84 ] NEQk NIP ?&sr #47 play &sr
145 POP
146
147 draw-octave
148
149BRK
150
151@on-message ( -> )
152
153 .Console/read DEI play
154 draw-octave
155
156BRK
157
158@on-mouse ( -> )
159
160 #00 .Mouse/state DEI NEQ #41 ADD ;cursor-icn update-cursor
161
162 .Mouse/state DEI ?on-mouse-touch
163
164BRK
165
166@on-mouse-touch ( -> )
167
168 .Mouse/x DEI2 .Mouse/y DEI2 .wave-view within-rect
169 ?on-touch-wave-view
170 .Mouse/x DEI2 .Mouse/y DEI2 .adsr-view within-rect
171 ?on-touch-knobs-view
172 .Mouse/x DEI2 .Mouse/y DEI2 .octave-view within-rect
173 ?on-touch-octave-view
174
175BRK
176
177@on-touch-wave-view ( -> )
178
179 .Mouse/state DEI #01 GTH ?&paint
180 .Mouse/x DEI2 .wave-view/x1 LDZ2 SUB2
181 ( min ) #0010 GTH2k [ JMP SWP2 POP2 ] set-length
182
183BRK
184
185&paint ( -> )
186
187 .Mouse/y DEI2 .wave-view/y1 LDZ2 SUB2 #20 SFT2 NIP
188 .Mouse/x DEI2 .wave-view/x1 LDZ2 SUB2 ;sin-pcm ADD2 STA
189 draw-wave
190 #10 ;on-frame/soft STA
191
192BRK
193
194@on-touch-octave-view ( -> )
195
196 .Mouse/x DEI2 .octave-view/x1 LDZ2 SUB2 #03 SFT2 NIP #09 NEQ ?&no-mod
197 .Mouse/y DEI2 .octave-view/y1 LDZ2 SUB2 #03 SFT2 NIP
198 [ #00 ] NEQk NIP ?&no-incr
199 .octave LDZ #03 EQU ?&no-incr
200 .octave LDZ INC .octave STZ &no-incr
201 [ #02 ] NEQk NIP ?&no-decr
202 .octave LDZ #ff EQU ?&no-decr
203 .octave LDZ #01 SUB .octave STZ &no-decr
204 POP
205 ( release ) #00 .Mouse/state DEO
206 draw-octave
207 BRK
208 &no-mod
209
210 .Mouse/x DEI2 .octave-view/x1 LDZ2 SUB2 #03 SFT2 NIP #06 GTH ?&no-key
211 .Mouse/x DEI2 .octave-view/x1 LDZ2 SUB2 #03 SFT2 ;notes-lut ADD2 LDA .octave LDZ #0c MUL ADD play
212 ( release ) #00 .Mouse/state DEO
213 draw-octave
214 &no-key
215
216BRK
217
218@on-touch-knobs-view ( -> )
219
220 .Mouse/x DEI2 .adsr-view/x1 LDZ2 SUB2 #03 SFT2 NIP #03 DIV
221 .Mouse/y DEI2 .adsr-view/y1 LDZ2 SUB2 NIP
222 OVR #04 LTH ?on-touch-adsr
223 OVR #04 GTH ?on-touch-vol
224 POP2
225
226BRK
227
228@on-touch-adsr ( knob value -> )
229
230 STH2
231 ( mask ) #ffff #000f #03 OVRr STHr SUB #60 SFT SFT2 EOR2
232 .Audio0/adsr DEI2 AND2
233 ( value ) #000f STHr OVR LTHk [ JMP SWP POP ] SUB
234 ( shift ) #03 STHr SUB #60 SFT SFT2 ORA2
235 set-env
236
237BRK
238
239@on-touch-vol ( knob value -> )
240
241 SWP #03 SUB INC INC SWP STH2
242 ( mask ) #0f OVRr STHr #60 SFT SFT
243 .Audio0/volume DEI AND
244 ( value ) #0f STHr OVR LTHk [ JMP SWP POP ] SUB
245 ( shift ) #01 STHr SUB #60 SFT SFT ORA
246 set-vol
247
248BRK
249
250(
251@|core )
252
253@play ( pitch -- )
254
255 DUP #0c DIVk MUL SUB ;draw-octave/last STA
256 DUP .Audio0/pitch DEO
257 #0c SUB .Audio1/pitch DEO
258
259JMP2r
260
261@set-length ( length* -- )
262
263 DUP2 .Audio0/length DEO2
264 .Audio1/length DEO2
265
266!draw-wave
267
268@set-vol ( vol -- )
269
270 DUP .Audio0/volume DEO
271 .Audio1/volume DEO
272
273!draw-adsr
274
275@set-env ( adsr* -- )
276
277 DUP2 .Audio0/adsr DEO2
278 .Audio1/adsr DEO2
279
280!draw-adsr
281
282@soften ( -- )
283
284 #0100 #0000
285 &l
286 DUP2 ;sin-pcm ADD2 get-average SWP2 STA POP
287 INC2 GTH2k ?&l
288 POP2 POP2
289 draw-wave
290
291JMP2r
292
293@get-average ( addr* -- addr* average* )
294
295 [ LIT2r 0000 ]
296 DUP2 #0001 SUB2 DUP2 #0002 ADD2 SWP2
297 &l
298 LDAk LITr 00 STH ADD2r
299 INC2 GTH2k ?&l
300 POP2 POP2
301 LDAk #00 SWP DUP2 DUP2 STH2r
302 #01 SFT2 ADD2 ADD2 ADD2 #02 SFT2
303
304JMP2r
305
306(
307@|drawing )
308
309@update-cursor ( color addr* -- )
310
311 [ LIT2 00 -Screen/auto ] DEO
312 #40 draw-cursor
313 .Mouse/x DEI2 ,draw-cursor/x STR2
314 .Mouse/y DEI2 ,draw-cursor/y STR2
315 .Screen/addr DEO2
316
317@draw-cursor ( color -- )
318
319 [ LIT2 &x $2 ] .Screen/x DEO2
320 [ LIT2 &y $2 ] .Screen/y DEO2
321 .Screen/sprite DEO
322
323JMP2r
324
325@draw-octave ( -- )
326
327 ( arrows )
328 [ LIT2 02 -Screen/auto ] DEO
329 .octave-view/x1 LDZ2 #0048 ADD2 .Screen/x DEO2
330 .octave-view/y1 LDZ2 .Screen/y DEO2
331 ;arrow-icns .Screen/addr DEO2
332 [ LIT2 01 -Screen/sprite ] DEO
333 ;font-hex .octave LDZ #03 ADD #00 SWP #30 SFT2 ADD2 .Screen/addr DEO2
334 [ LIT2 02 -Screen/sprite ] DEO
335 ;arrow-icns/down .Screen/addr DEO2
336 [ LIT2 01 -Screen/sprite ] DEO
337 ( octave )
338 .octave-view/x1 LDZ2 .Screen/x DEO2
339 .octave-view/y1 LDZ2 .Screen/y DEO2
340 [ LIT2 06 -Screen/auto ] DEO
341 [ LITr &last ff ]
342 ;keys-left-icns STHkr #00 EQU INC draw-key
343 ;keys-middle-icns STHkr #02 EQU INC draw-key
344 ;keys-right-icns STHkr #04 EQU INC draw-key
345 ;keys-left-icns STHkr #05 EQU INC draw-key
346 ;keys-middle-icns STHkr #07 EQU INC draw-key
347 ;keys-middle-icns STHkr #09 EQU INC draw-key
348 ;keys-right-icns STHr #0b EQU INC
349
350( >> )
351
352@draw-key ( addr* color -- )
353
354 STH
355 .Screen/addr DEO2
356 .Screen/y DEI2
357 STHr .Screen/sprite DEOk DEOk DEO
358 .Screen/x DEI2k #0008 ADD2 ROT DEO2
359 .Screen/y DEO2
360
361JMP2r
362
363@draw-adsr ( -- )
364
365 ( adsr )
366 .adsr-view/x1 LDZ2 .adsr-view/y1 LDZ2
367 .Audio0/adsr DEI #04 SFT draw-knob
368 .adsr-view/x1 LDZ2 #0018 ADD2 .adsr-view/y1 LDZ2
369 .Audio0/adsr DEI #0f AND draw-knob
370 .adsr-view/x1 LDZ2 #0030 ADD2 .adsr-view/y1 LDZ2
371 .Audio0/adsr INC DEI #04 SFT draw-knob
372 .adsr-view/x1 LDZ2 #0048 ADD2 .adsr-view/y1 LDZ2
373 .Audio0/adsr INC DEI #0f AND draw-knob
374 ( volume )
375 .adsr-view/x2 LDZ2 #0028 SUB2 .adsr-view/y1 LDZ2
376 .Audio0/volume DEI #04 SFT draw-knob
377 .adsr-view/x2 LDZ2 #0010 SUB2 .adsr-view/y1 LDZ2
378 .Audio0/volume DEI #0f AND
379
380!draw-knob
381
382@draw-wave ( -- )
383
384 ( background )
385 .wave-view/x1 LDZ2 .Screen/x DEO2
386 .wave-view/y1 LDZ2 .Screen/y DEO2
387 ;fill-icn .Screen/addr DEO2
388 [ LIT2 75 -Screen/auto ] DEO
389 #e0 &lbg
390 ;dotted-icn .Screen/addr DEO2
391 [ LIT2 0c -Screen/sprite ] DEO
392 INC DUP ?&lbg
393 POP
394 .wave-view/x1 LDZ2 .Screen/x DEO2
395 ( waveform )
396 [ LIT2 01 -Screen/auto ] DEO
397 ;sin-pcm/end ;sin-pcm
398 &loop
399 DUP2 ;sin-pcm SUB2 .Audio0/length DEI2 DIV2k MUL2 SUB2 ;sin-pcm ADD2 LDA
400 #00 SWP #02 SFT2 .wave-view/y1 LDZ2 ADD2 .Screen/y DEO2
401 ( draw ) DUP2 ;sin-pcm SUB2 NIP .Audio0/length DEI2 NIP #01 SUB GTH INC .Screen/pixel DEO
402 INC2 GTH2k ?&loop
403 POP2 POP2
404 ( length line )
405 .wave-view/x1 LDZ2 .Audio0/length DEI2 #0001 SUB2 ADD2 .Screen/x DEO2
406 .wave-view/y1 LDZ2 .Screen/y DEO2
407 ;line-icn .Screen/addr DEO2
408 [ LIT2 71 -Screen/auto ] DEO
409 [ LIT2 05 -Screen/sprite ] DEO
410 ( range )
411 [ LIT2 01 -Screen/auto ] DEO
412 .wave-view/x1 LDZ2 .Screen/x DEO2
413 .wave-view/y1 LDZ2 #0018 SUB2 .Screen/y DEO2
414 .Audio0/length DEI2
415
416!draw-short
417
418@draw-knob ( x* y* value -- )
419
420 STH
421 OVR2 OVR2 .Screen/y DEO2 .Screen/x DEO2
422 ( circle )
423 ;knob-icns .Screen/addr DEO2
424 [ LIT2 16 -Screen/auto ] DEO
425 [ LIT2 01 -Screen/sprite ] DEOk DEO
426 ( value )
427 #0010 ADD2 .Screen/y DEO2
428 #0004 ADD2 .Screen/x DEO2
429 ;font-hex #00 STHkr #30 SFT ADD2 .Screen/addr DEO2
430 [ LIT2 00 -Screen/auto ] DEO
431 [ LIT2 01 -Screen/sprite ] DEO
432 ( marker )
433 .Screen/x DEI2 #0004 SUB2 #0000 STHkr ;knob-offsetx ADD2 LDA ADD2 .Screen/x DEO2
434 .Screen/y DEI2 #0010 SUB2 #0000 STHr ;knob-offsety ADD2 LDA ADD2 .Screen/y DEO2
435 ;knob-icns/index .Screen/addr DEO2
436 [ LIT2 05 -Screen/sprite ] DEO
437
438JMP2r
439
440@draw-short ( short* -- )
441
442 SWP draw-byte
443
444@draw-byte ( byte -- )
445
446 DUP #04 SFT draw-hex #0f AND
447
448@draw-hex ( char -- )
449
450 #00 SWP #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
451 [ LIT2 02 -Screen/sprite ] DEO
452
453JMP2r
454
455@within-rect ( x* y* rect -- flag )
456
457 STH
458 ( y < rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ?&skip
459 ( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ?&skip
460 SWP2
461 ( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ?&skip
462 ( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ?&skip
463 POP2 POP2 POPr
464 #01
465JMP2r
466 &skip
467 POP2 POP2 POPr
468 #00
469
470JMP2r
471
472@phex ( short* -- ) SWP phex/b &b DUP #04 SFT phex/c &c #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO JMP2r
473
474(
475@|assets )
476
477@notes-lut [
478 30 32 34 35 37 39 3b 3c ]
479
480@dotted-icn [
481 0000 0000 0000 0000
482 0000 0000 0000 0000
483 0000 0000 0000 0000
484 0000 0000 0000 0000
485 aa00 0000 0000 0000
486 0000 0000 0000 0000
487 0000 0000 0000 0000
488 0000 0000 0000 0000 ]
489@line-icn [
490 8080 8080 8080 8080
491 ]
492@fill-icn [
493 ffff ffff ffff ffff ]
494@cursor-icn [
495 80c0 e0f0 f8e0 1000 ]
496@arrow-icns [
497 0010 387c fe10 1000
498&down
499 0010 1010 fe7c 3810 ]
500@keys-left-icns [
501 7c7c 7c7c 7c7c 7c7c
502 7c7c 7c7c 7c7c 7e7f
503 7f7f 7f7f 7f7f 3e00 ]
504@keys-middle-icns [
505 1c1c 1c1c 1c1c 1c1c
506 1c1c 1c1c 1c1c 3e7f
507 7f7f 7f7f 7f7f 3e00 ]
508@keys-right-icns [
509 1f1f 1f1f 1f1f 1f1f
510 1f1f 1f1f 1f1f 3f7f
511 7f7f 7f7f 7f7f 3e00 ]
512@knob-icns [
513 0003 0c10 2020 4040
514 00c0 3008 0404 0202
515 4040 2020 100c 0300
516 0202 0404 0830 c000
517 &index
518 0000 183c 3c18 0000 ]
519@knob-offsetx [
520 01 00 00 00 00 01 02 03
521 05 06 07 08 08 08 08 07 ]
522@knob-offsety [
523 07 06 05 03 02 01 00 00
524 00 00 01 02 03 05 06 07 ]
525@font-hex [
526 007c 8282 8282 827c 0030 1010 1010 1010
527 007c 8202 7c80 80fe 007c 8202 1c02 827c
528 000c 1424 4484 fe04 00fe 8080 7c02 827c
529 007c 8280 fc82 827c 007c 8202 1e02 0202
530 007c 8282 7c82 827c 007c 8282 7e02 827c
531 007c 8202 7e82 827e 00fc 8282 fc82 82fc
532 007c 8280 8080 827c 00fc 8282 8282 82fc
533 007c 8280 f080 827c 007c 8280 f080 8080 ]
534
535( pad ) [ 8080 8080 ]
536@sin-pcm [
537 8083 8689 8c8f 9295 989b 9ea1 a4a7 aaad
538 b0b3 b6b9 bbbe c1c3 c6c9 cbce d0d2 d5d7
539 d9db dee0 e2e4 e6e7 e9eb ecee f0f1 f2f4
540 f5f6 f7f8 f9fa fbfb fcfd fdfe fefe fefe
541 fffe fefe fefe fdfd fcfb fbfa f9f8 f7f6
542 f5f4 f2f1 f0ee eceb e9e7 e6e4 e2e0 dedb
543 d9d7 d5d2 d0ce cbc9 c6c3 c1be bbb9 b6b3
544 b0ad aaa7 a4a1 9e9b 9895 928f 8c89 8683
545 807d 7a77 7471 6e6b 6865 625f 5c59 5653
546 504d 4a47 4542 3f3d 3a37 3532 302e 2b29
547 2725 2220 1e1c 1a19 1715 1412 100f 0e0c
548 0b0a 0908 0706 0505 0403 0302 0202 0202
549 0102 0202 0202 0303 0405 0506 0708 090a
550 0b0c 0e0f 1012 1415 1719 1a1c 1e20 2225
551 2729 2b2e 3032 3537 3a3d 3f42 4547 4a4d
552 5053 5659 5c5f 6265 686b 6e71 7477 7a7d ]
553 &end
554( pad ) [ 8080 8080 ]
555
View as plain text