2020-04-18 20:53:11 +00:00
|
|
|
var voice
|
|
|
|
|
var op
|
|
|
|
|
|
|
|
|
|
: op-with-voice voice @
|
|
|
|
|
dup 5 > if 5 + then
|
|
|
|
|
dup 2 > if 5 + then
|
|
|
|
|
+ op @ + ;
|
|
|
|
|
: opreg create b, does> ub@ op-with-voice ;
|
|
|
|
|
: voicereg create b, does> ub@ voice @ + ;
|
|
|
|
|
|
|
|
|
|
0x20 opreg ar-flags
|
|
|
|
|
0x40 opreg ar-level
|
|
|
|
|
0x60 opreg ar-ad
|
|
|
|
|
0x80 opreg ar-sr
|
|
|
|
|
0xe0 opreg ar-wave
|
|
|
|
|
0xc0 voicereg ar-alg
|
|
|
|
|
|
|
|
|
|
0xa0 voicereg ar-freq
|
|
|
|
|
0xb0 voicereg ar-note
|
|
|
|
|
|
|
|
|
|
: op2 3 op ! ;
|
|
|
|
|
: op1 0 op ! ;
|
|
|
|
|
: loadop ( flags level ad sr wave -- )
|
|
|
|
|
ar-wave adlib!
|
|
|
|
|
ar-sr adlib!
|
|
|
|
|
ar-ad adlib!
|
|
|
|
|
ar-level adlib!
|
|
|
|
|
ar-flags adlib! ;
|
|
|
|
|
|
|
|
|
|
: readop ( v -- )
|
|
|
|
|
>r r@ 4 + b@ r@ 3 + b@ r@ 2 + b@ r@ 1 + b@ <r b@ loadop ;
|
|
|
|
|
|
|
|
|
|
: instrument ( alg f1 l1 ad1 sr1 w1 f2 l2 ad2 sr2 w2 -- )
|
|
|
|
|
array b, b, b, b, b, b, b, b, b, b, b, ;
|
|
|
|
|
|
|
|
|
|
: loadinst ( p -- ) dup dup 5 + op1 readop op2 readop
|
|
|
|
|
10 + b@ ar-alg adlib! ;
|
|
|
|
|
|
|
|
|
|
: freqon ( oct freq -- )
|
|
|
|
|
dup 0xff & ar-freq adlib!
|
|
|
|
|
8 >> 0x03 & swap 2 << | 0x20 | ar-note adlib! ;
|
|
|
|
|
: noteoff ( -- ) 0 ar-note adlib! ; userword
|
|
|
|
|
|
|
|
|
|
array semitones
|
|
|
|
|
3520 3520 />ratio ,
|
|
|
|
|
3729 3520 />ratio ,
|
|
|
|
|
3951 3520 />ratio ,
|
|
|
|
|
4186 3520 />ratio ,
|
|
|
|
|
4435 3520 />ratio ,
|
|
|
|
|
4699 3520 />ratio ,
|
|
|
|
|
4978 3520 />ratio ,
|
|
|
|
|
5274 3520 />ratio ,
|
|
|
|
|
5588 3520 />ratio ,
|
|
|
|
|
5920 3520 />ratio ,
|
|
|
|
|
6272 3520 />ratio ,
|
|
|
|
|
6645 3520 />ratio ,
|
|
|
|
|
|
|
|
|
|
: note dup 12 / 8 % swap 12 % cells semitones + @ 440 swap *<ratio ;
|
|
|
|
|
: noteon noteoff note freqon ;
|
2020-04-19 02:12:57 +00:00
|
|
|
: randnoteon rand 12 % noteon ;
|
2020-04-18 20:53:11 +00:00
|
|
|
|
|
|
|
|
: panic 9 -1 for i voice ! noteoff next ; userword
|
|
|
|
|
|
|
|
|
|
var octave
|
|
|
|
|
: oct+ octave @ 12 * + ;
|
|
|
|
|
: rest 2 sleep ;
|
|
|
|
|
: mknote create b, does> ub@ oct+ noteon ;
|
|
|
|
|
|
|
|
|
|
11 mknote %G# userword
|
|
|
|
|
10 mknote %G userword
|
|
|
|
|
9 mknote %F# userword
|
|
|
|
|
8 mknote %F userword
|
|
|
|
|
7 mknote %E userword
|
|
|
|
|
6 mknote %D# userword
|
|
|
|
|
5 mknote %D userword
|
|
|
|
|
4 mknote %C# userword
|
|
|
|
|
3 mknote %C userword
|
|
|
|
|
2 mknote %B userword
|
|
|
|
|
1 mknote %A# userword
|
|
|
|
|
0 mknote %A userword
|
|
|
|
|
|
|
|
|
|
202 14 24 0 244 2 3 16 3 52 119 1 instrument garbinst
|
|
|
|
|
202 1 4 0 248 190 0 0 39 214 79 0 instrument bink
|
|
|
|
|
202 4 37 0 67 52 3 1 80 54 119 0 instrument zoop
|
|
|
|
|
202 10 134 129 239 1 0 1 3 152 241 0 instrument doorinst
|
2020-04-19 02:12:57 +00:00
|
|
|
202 14 245 79 247 182 3 210 18 163 245 0 instrument terminst
|
|
|
|
|
202 10 1 9 244 186 3 12 137 181 185 0 instrument norm-rexxinst
|
|
|
|
|
202 12 0 208 244 186 3 12 11 181 185 0 instrument sick-rexxinst
|
|
|
|
|
202 14 18 0 244 2 3 22 3 244 103 0 instrument splode
|
|
|
|
|
202 0 0 15 248 5 1 202 128 205 20 1 instrument libbinst
|
|
|
|
|
|
|
|
|
|
defer rexxinst
|
|
|
|
|
' norm-rexxinst ' rexxinst redefine
|
2020-04-18 20:53:11 +00:00
|
|
|
|
|
|
|
|
task const SFX
|
|
|
|
|
SFX :noname activate begin receive execute again ; execute
|
|
|
|
|
|
|
|
|
|
: loadsfx ( inst oct -- ) octave ! loadinst ;
|
|
|
|
|
: sfx-garbage garbinst 4 loadsfx %C ;
|
|
|
|
|
: sfx-bink bink 6 loadsfx %C ;
|
|
|
|
|
: sfx-confirm bink 6 loadsfx %C rest %E rest %C rest %G rest ;
|
|
|
|
|
: sfx-zoop zoop 5 loadsfx %C ;
|
|
|
|
|
: sfx-dooropen :| doorinst 4 loadsfx %C rest %E |; SFX send ;
|
2020-04-19 02:12:57 +00:00
|
|
|
: sfx-doorclose :| doorinst 4 loadsfx %E rest %C |; SFX send ;
|
|
|
|
|
: term-jingle terminst 3 loadsfx %E rest %F rest %G 6 sleep ;
|
|
|
|
|
: sfx-termon :| term-jingle 4 octave ! %C |; SFX send ;
|
|
|
|
|
: sfx-termoff :| term-jingle %C |; SFX send ;
|
|
|
|
|
: sfx-splode splode 0 loadsfx %C ;
|
|
|
|
|
: sfx-rexx
|
|
|
|
|
:| rexxinst 2 loadsfx %C rest %G rest %E rest 3 octave ! %C |;
|
|
|
|
|
SFX send ;
|
|
|
|
|
: sfx-libb :| libbinst 2 loadsfx %D# rest %G# rest %F# rest %G |; SFX send ;
|
