diff --git a/defs.jor b/defs.jor index a350ed7..2d889d2 100755 --- a/defs.jor +++ b/defs.jor @@ -64,6 +64,8 @@ : min ( x y -- x|y ) 2dup > if swap then drop ; : max ( x y -- x|y ) 2dup < if swap then drop ; +: +!pos ( n var -- ) dup @ dup @ here! @@ -73,6 +75,13 @@ : intern create latest wordname , does> @ ; +: preserving ( cp 0 vars... -- ) + 0 r> begin dup while dup @ r> r> repeat drop + execute + begin r@ while r< r< swap ! repeat rdrop ; +: preserve ( cp var -- ) 0 swap preserves ; + + : decompile word lookup if 1 begin ( cp i ) 2dup cells + @ ( cp i @cp+i ) diff --git a/jopl.c b/jopl.c index ac35f94..9c91e24 100755 --- a/jopl.c +++ b/jopl.c @@ -3,6 +3,7 @@ #include "adlib.h" #include "kbd.h" #include "timer.h" +#include "serial.h" cell ontick = 0; void f_adlib_read() { @@ -64,12 +65,22 @@ char *gather_input() { return NULL; } +void f_seremit() { + ser_write_byte(TOP().i); + if (TOP().i == '\n') { + ser_write_byte('\r'); + } + DROP(1); +} + void do_repl(char *exe) { adlib_init(); timer_init(TIMER_18HZ); f_init(exe); + ser_init(SER_COM2, BAUD_19200, SER_8N1); + CDEF("seremit", f_seremit); CDEF("_quit", f_quit); CDEF("adlib!", f_adlib_write); CDEF("adlib@", f_adlib_read); diff --git a/jopl.exe b/jopl.exe index 735eb43..400eb97 100755 Binary files a/jopl.exe and b/jopl.exe differ diff --git a/jopl.jor b/jopl.jor index 276a008..765365b 100755 --- a/jopl.jor +++ b/jopl.jor @@ -3,6 +3,10 @@ s" jopl.log" open seekend fdeactivate const LOGFILE : emit-log fdeactivate LOGFILE factivate fputc fdeactivate drop factivate ; : quit LOGFILE factivate close _quit ; + +: DBG :| ' seremit task-emit ! execute cr |; 0 task-emit preserving ; +: DTYPE ' type DBG ; + : start-repl activate ' putc task-emit ! ' emit-log task-echo ! s" .:: J O P L ( jean OPL2 print loop) ::." type cr @@ -164,6 +168,7 @@ array tracks 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , var textx var texty var textattr +var textleft 0x1f textattr ! : out-direct ( c -- ) @@ -171,6 +176,12 @@ var textattr texty @ 160 * textx @ 1 << + 0xb800 !far ; +: setattr-to ( w -- ) + texty @ 80 * textx @ + + dup rot + for dup i 1 << 1 + 0xb800 b!far next drop ; + : clearline textattr @ 8 << texty @ 80 * textx @ + @@ -180,12 +191,15 @@ var textattr : +textx! ( n -- ) textx @ + dup 80 >= if drop cr else textx ! then ; : emit-direct ( c -- ) - dup '\n' = if 0 textx ! 1 texty +! drop else + dup '\n' = if textleft @ textx ! 1 texty +! drop else dup '\r' = if drop else out-direct 1 +textx! then then ; +: rpad ( n -- ) + textleft @ + textx @ for bl next ; + : status - 0 textx ! 0 texty ! + 0 textx ! 0 texty ! 0 textleft ! s" V: " type voice @ . s" O: " type octave @ . s" T: " type songticks @ . @@ -225,7 +239,7 @@ var t2 t2 @ 0x03 adlib! 0x42 0x04 adlib! ; -: ontick startt2 player status trackstatus ; +: ontick startt2 player ' status 0 textleft textx texty preserving ( trackstatus ) ; : keynote [ inline| 44 b, 31 b, 45 b, 32 b, 46 b, 47 b, 34 b, 48 b, 35 b, 49 b, 36 b, 50 b, @@ -236,16 +250,18 @@ var t2 : onkeynote ( cp -- ) keynote dup if oct+ swap execute else drop drop then ; +var stopkeys +: stoponesc 1 key-pressed if 1 stopkeys ! then ; +: voicekeys + 78 key-pressed if 1 octave +! then + 74 key-pressed if -1 octave +! then + 75 key-pressed if -1 +voice! then + 77 key-pressed if 1 +voice! then ; + : dokeys ( cp -- ) - r> key-start begin - key-debounce 1 key-pressed not while - 78 key-pressed if 1 octave +! then - 74 key-pressed if -1 octave +! then - 75 key-pressed if -1 +voice! then - 77 key-pressed if 1 +voice! then - r@ execute - suspend - repeat key-end rdrop ; + r> 0 stopkeys ! key-start begin + key-debounce r@ execute suspend + stopkeys @ until key-end rdrop ; : nextnote ( ip -- ip ) dup if @@ -261,16 +277,66 @@ var t2 : record 0x4f textattr ! - :| ' setnote onkeynote + :| stoponesc voicekeys + ' setnote onkeynote 41 key-pressed if 0xfd setnote then 52 key-down if 0xf0 setnote then |; dokeys 0x1f textattr ! ; -: jam - :| ' noteon onkeynote - 41 key-pressed if noteoff then - |; dokeys ; +: jamkeys + stoponesc voicekeys + ' noteon onkeynote + 41 key-pressed if noteoff then ; + +: jam ' jamkeys dokeys ; + +var menuscroll +var menuy + +: menu-at ( cp x y -- ) + :| texty ! dup textx ! textleft ! ' emit-direct task-emit ! + 0 menuscroll ! 0 menuy ! + execute |; + 0 textleft task-emit preserving ; + +: menu-lines ( -- count ) 24 texty @ - ; +: menu-skip menuscroll @ 0 max ; +: menu-selectedy menuy @ menu-skip - texty @ + ; +: draw-menu ( cp -- ) 0 texty textattr preserving ; + +: menuitem-bg ( w attr -- ) + :| menu-selectedy texty ! + textleft @ textx ! + textattr ! setattr-to |; + 0 texty textx textattr preserving ; + +: deselect-menu ( w -- ) 0x1f menuitem-bg ; +: select-menu ( w -- ) 0x30 menuitem-bg ; + +: key-menu ( w -- redraw ) + :| + 0 r> + 72 key-pressed if dup deselect-menu -1 menuy +!pos dup select-menu then + 80 key-pressed if dup deselect-menu 1 menuy +!pos dup select-menu then + 73 key-pressed if rdrop 1 r> -10 menuscroll +!pos then + 81 key-pressed if rdrop 1 r> 10 menuscroll +!pos then + drop r< + |; draw-menu ; + +: draw-filemenu ( glob -- ) + :| findfile + menu-skip 0 for drop nextfile next + menu-lines 0 for dup if type else drop then 13 rpad cr nextfile next + drop |; draw-menu ; + +: filemenu ( glob -- filename ) + :| dup draw-filemenu 13 select-menu + :| jamkeys + 13 key-menu if dup draw-filemenu then + 28 key-pressed if ( todo: get filename ) 1 stopkeys ! then + |; dokeys + |; 66 1 menu-at ; :noname 9 -1 for i voice ! default next diff --git a/jopl.prj b/jopl.prj index 2dabce4..9d1b09f 100755 Binary files a/jopl.prj and b/jopl.prj differ diff --git a/jorth.c b/jorth.c index b74f752..4e63e4a 100755 --- a/jorth.c +++ b/jorth.c @@ -427,6 +427,14 @@ void f_printstack() { } } +void f_printrstack() { + cell *v = RUNNING + RSTACK_OFFSET; + while (v != rstack) { + PUSHC(*v++); + f_dot(); + } +} + void f_cr() { PUSHI('\n'); f_emit(); @@ -761,9 +769,9 @@ struct ffblk findfile; void f_findfirst() { int result = findfirst(TOP().s, &findfile, 0); if (result == 0) { - PUSHS(findfile.ff_name); + TOP().s = findfile.ff_name; } else { - PUSHU(0); + TOP().u = 0; } } @@ -776,6 +784,11 @@ void f_findnext() { } } +void f_chdir() { + chdir(TOP().s); + DROP(1); +} + void f_swapinput() { cell *key = RUNNING + TASK_USER_KEY; cell *keysrc = RUNNING + TASK_USER_KEYSRC; @@ -1152,6 +1165,7 @@ void f_init(char *exe) { CDEF("u.", f_udot); CDEF("type", f_puts); CDEF(".s", f_printstack); + CDEF(".rs", f_printrstack); CDEF(",", f_comma); CDEF("b,", f_bcomma); CDEF("open", f_open); @@ -1171,6 +1185,7 @@ void f_init(char *exe) { CDEF("fread", f_fread); CDEF("findfile", f_findfirst); CDEF("nextfile", f_findnext); + CDEF("chdir", f_chdir); CDEF("imagefilename", f_imagefilename); CDEF("image-uptodate", f_image_up_to_date); CDEF("loadimage", f_loadimage); diff --git a/jorth.h b/jorth.h index 473fcdf..e5b1d87 100755 --- a/jorth.h +++ b/jorth.h @@ -2,7 +2,7 @@ #define MEM_SIZE 16384 #define STACK_SIZE 64 -#define RSTACK_SIZE 32 +#define RSTACK_SIZE 64 void f_init(char *exe);