log session to jopl.log; add ability to dump track source
This commit is contained in:
parent
d23e8c1172
commit
4fcf03fd07
2
jopl.c
2
jopl.c
|
@ -61,7 +61,7 @@ void do_repl(char *exe) {
|
|||
timer_init(TIMER_18HZ);
|
||||
f_init(exe);
|
||||
|
||||
CDEF("quit", f_quit);
|
||||
CDEF("_quit", f_quit);
|
||||
CDEF("adlib!", f_adlib_write);
|
||||
CDEF("adlib@", f_adlib_read);
|
||||
CDEF("findfile", f_findfirst);
|
||||
|
|
51
jopl.jor
51
jopl.jor
|
@ -1,6 +1,10 @@
|
|||
' putc task-emit !
|
||||
s" jopl.log" open seekend fdeactivate const LOGFILE
|
||||
: emit-log fdeactivate LOGFILE factivate fputc fdeactivate drop factivate ;
|
||||
: quit LOGFILE factivate close _quit ;
|
||||
|
||||
: start-repl activate ' putc task-emit !
|
||||
: start-repl activate
|
||||
' putc task-emit ! ' emit-log task-echo !
|
||||
s" .:: J O P L ( jean OPL2 print loop) ::." type cr
|
||||
begin receive loadstring s" ok" type cr again ;
|
||||
task const REPL
|
||||
|
@ -104,18 +108,19 @@ var octave
|
|||
: %% 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#
|
||||
10 mknote G
|
||||
9 mknote F#
|
||||
8 mknote F
|
||||
7 mknote E
|
||||
6 mknote D#
|
||||
5 mknote D
|
||||
4 mknote C#
|
||||
3 mknote C
|
||||
2 mknote B
|
||||
1 mknote A#
|
||||
0 mknote A
|
||||
|
||||
array tracks 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
|
||||
|
||||
|
@ -135,6 +140,28 @@ array tracks 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
|
|||
: ;track %loop 0 notestate ! ;
|
||||
: shush 0 voice @ track ! %- ;
|
||||
|
||||
: prev-name ( wordname -- wordname )
|
||||
2 cells - @ 2 cells + ;
|
||||
: 'name [ ' [ , ' ' , ' ] , ] ` lit ; immediate
|
||||
|
||||
: emit-octave ( note -- )
|
||||
12 / dup octave @ != if dup octave ! . s" %O " type else drop then ;
|
||||
|
||||
: emit-note ( note -- )
|
||||
'name A swap 12 mod 0 for prev-name next type bl ;
|
||||
|
||||
: emit-cmd ( cmd -- more )
|
||||
dup 0xf0 = if s" % " type then
|
||||
dup 0xfd = if s" %- " type then
|
||||
dup 0xf0 < if dup emit-octave emit-note 1 then
|
||||
dup 0xfe = if 'name ;track type cr drop 0 then ;
|
||||
|
||||
: emit-track ( 'track -- )
|
||||
-1 octave ! dup ` swap 2 cells +
|
||||
'name :track type bl swap type bl
|
||||
begin dup ub@ emit-cmd while 1 + repeat drop ;
|
||||
|
||||
|
||||
var tempo 1 tempo !
|
||||
: player
|
||||
1 songticks +!
|
||||
|
|
Loading…
Reference in a new issue