Jeremy Penner
49f532a85b
I now have multiple executables that depend on the same .jor source files and I am not diligent about ensuring that both are up-to-date and working. As small changes to source files can cause .jim files to fail silently, I've removed them from the repo for now.
153 lines
3.3 KiB
Plaintext
Executable file
153 lines
3.3 KiB
Plaintext
Executable file
' putc task-emit !
|
|
|
|
: start-repl activate ' putc task-emit !
|
|
s" .:: J O P L ( jean OPL2 print loop) ::." type cr
|
|
begin receive loadstring s" ok" type cr again ;
|
|
task const REPL
|
|
REPL start-repl
|
|
|
|
var voice
|
|
var op
|
|
|
|
: op-with-voice voice @
|
|
dup 2 > if 5 + then
|
|
dup 5 > 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 -- )
|
|
create b, b, b, b, b, b, b, b, b, b, b, does>
|
|
dup dup 5 + op1 readop op2 readop
|
|
10 + b@ ar-alg adlib! ;
|
|
|
|
0 0x01 0x10 0xf0 0x77 0 0x01 0x00 0xf0 0x77 0 instrument default
|
|
|
|
: freqon ( oct freq -- )
|
|
dup 0xff & ar-freq adlib!
|
|
8 >> 0x03 & swap 2 << | 0x20 | ar-note adlib! ;
|
|
: noteoff ( -- ) 0 ar-note adlib! ;
|
|
|
|
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 ;
|
|
|
|
: read-sbi-reg ( reg-cp -- )
|
|
fgetc swap execute adlib! ;
|
|
|
|
: read-sbi-op-reg ( reg-cp -- )
|
|
dup op1 read-sbi-reg
|
|
op2 read-sbi-reg ;
|
|
|
|
: loadsbi ( filename -- )
|
|
open 36 seek
|
|
' ar-flags read-sbi-op-reg
|
|
' ar-level read-sbi-op-reg
|
|
' ar-ad read-sbi-op-reg
|
|
' ar-sr read-sbi-op-reg
|
|
' ar-wave read-sbi-op-reg
|
|
fgetc ar-alg adlib!
|
|
close ;
|
|
|
|
: panic 9 -1 for i voice ! noteoff next ;
|
|
|
|
var songticks
|
|
|
|
var notestate
|
|
var octave
|
|
: rest songticks @ begin dup songticks @ != until drop ;
|
|
: beat begin dup songticks @ swap % 0 != while rest repeat drop ;
|
|
: %O octave ! ;
|
|
: %V voice ! ;
|
|
: mknote create b, does> ub@ octave @ 12 * + notestate @ if b, else noteon rest then ;
|
|
: %loop 0xfe b, , ;
|
|
: % notestate @ if 0xf0 b, else rest then ;
|
|
: %% 0 for % next ;
|
|
: %- notestate @ if 0xfd b, else noteoff then ;
|
|
: %do 0xff b, , ;
|
|
0 mknote A
|
|
1 mknote A#
|
|
2 mknote B
|
|
3 mknote C
|
|
4 mknote C#
|
|
5 mknote D
|
|
6 mknote D#
|
|
7 mknote E
|
|
8 mknote F
|
|
9 mknote F#
|
|
10 mknote G
|
|
11 mknote G#
|
|
|
|
array tracks 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
|
|
|
|
: track ( i -- p ) cells tracks + ;
|
|
: dotrack ( ip -- ip )
|
|
dup if dup 1 + swap ub@ r>
|
|
r@ 0xff = if dup @ swap cell + swap execute then
|
|
r@ 0xfe = if @ dotrack then
|
|
r@ 0xfd = if noteoff then
|
|
r@ 0xf0 < if r@ noteon then
|
|
rdrop then ;
|
|
|
|
: track-tick ( i -- )
|
|
track dup @ dotrack swap ! ;
|
|
|
|
: :track create here 1 notestate ! does> voice @ track ! ;
|
|
: ;track %loop 0 notestate ! ;
|
|
: shush 0 voice @ track ! %- ;
|
|
|
|
: player
|
|
songticks @ 1 + songticks !
|
|
voice @
|
|
0 10 for i voice ! i track-tick next
|
|
voice ! ;
|
|
|
|
var t2
|
|
: startt2
|
|
0x60 0x04 adlib!
|
|
0x80 0x04 adlib!
|
|
t2 @ 0x03 adlib!
|
|
0x42 0x04 adlib! ;
|
|
|
|
: ontick adlib@ 0x20 & if startt2 player then ;
|
|
|
|
:noname
|
|
default
|
|
startt2
|
|
; ' onload redefine
|