log session to jopl.log; add ability to dump track source

This commit is contained in:
Jeremy Penner 2019-04-13 10:30:36 -04:00
parent d23e8c1172
commit 4fcf03fd07
4 changed files with 40 additions and 13 deletions

2
jopl.c
View file

@ -61,7 +61,7 @@ void do_repl(char *exe) {
timer_init(TIMER_18HZ); timer_init(TIMER_18HZ);
f_init(exe); f_init(exe);
CDEF("quit", f_quit); CDEF("_quit", f_quit);
CDEF("adlib!", f_adlib_write); CDEF("adlib!", f_adlib_write);
CDEF("adlib@", f_adlib_read); CDEF("adlib@", f_adlib_read);
CDEF("findfile", f_findfirst); CDEF("findfile", f_findfirst);

BIN
jopl.exe

Binary file not shown.

View file

@ -1,6 +1,10 @@
' putc task-emit ! ' 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 s" .:: J O P L ( jean OPL2 print loop) ::." type cr
begin receive loadstring s" ok" type cr again ; begin receive loadstring s" ok" type cr again ;
task const REPL task const REPL
@ -104,18 +108,19 @@ var octave
: %% 0 for % next ; : %% 0 for % next ;
: %- notestate @ if 0xfd b, else noteoff then ; : %- notestate @ if 0xfd b, else noteoff then ;
: %do 0xff b, , ; : %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# 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 , 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 ! ; : ;track %loop 0 notestate ! ;
: shush 0 voice @ track ! %- ; : 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 ! var tempo 1 tempo !
: player : player
1 songticks +! 1 songticks +!

BIN
jopl.prj

Binary file not shown.