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 ;
: randnoteon rand 12 % noteon ;

: 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
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

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 ;
: 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 ;