jopl: implement interactive instrument loading menu

This commit is contained in:
Jeremy Penner 2019-05-08 20:37:40 -04:00
parent a150b8fec3
commit 38db6f71f3
7 changed files with 121 additions and 20 deletions

View file

@ -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 @ <rot + 0 max swap ! ;
: checkpoint ( cp -- )
create here 4 cells + , latest , tasks , ,
does> 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 )

11
jopl.c
View file

@ -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);

BIN
jopl.exe

Binary file not shown.

View file

@ -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 +
textattr @ >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 ;
: dokeys ( cp -- )
r> key-start begin
key-debounce 1 key-pressed not while
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
r@ execute
suspend
repeat key-end rdrop ;
77 key-pressed if 1 +voice! then ;
: dokeys ( cp -- )
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

BIN
jopl.prj

Binary file not shown.

19
jorth.c
View file

@ -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);

View file

@ -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);