promote "files" from jopl, words to simplify switching active files temporarily

This commit is contained in:
Jeremy Penner 2019-04-27 11:12:39 -04:00
parent 64d421429e
commit e96942da52
11 changed files with 39 additions and 69 deletions

View file

@ -28,6 +28,10 @@ key const sp
: inline| ' INLINEDATA_ , here 0 , ; : inline| ' INLINEDATA_ , here 0 , ;
: |inline [ ' then , ] ; : |inline [ ' then , ] ;
' cells @ const $DOCOLON ( get the colon execution token )
: :| inline| $DOCOLON , ; immediate
: |; ' ret , |inline ; immediate
key " const '"' key " const '"'
: s" state if inline| else here then : s" state if inline| else here then
@ -83,13 +87,14 @@ defer onload
: interpretjor ( filename -- ) : interpretjor ( filename -- )
open fdeactivate ' key-file load-input drop factivate close ; open fdeactivate ' key-file load-input drop factivate close ;
: loadjor fdeactivate swap interpretjor postload factivate ; : preservefp ( xt -- ) fdeactivate r> execute r< factivate ;
: loadjor :| interpretjor postload |; preservefp ;
: loadfile ( filename -- ) : loadfile ( filename -- )
( active file is preserved for the currently-loading file, but the ( active file is preserved for the currently-loading file, but the
new file is always loaded with no active files ) new file is always loaded with no active files )
fdeactivate swap :| dup loadimage-if-uptodate not if
dup loadimage-if-uptodate not if here over r> r> interpretjor
dup here swap interpretjor r< r< imagefilename overwrite saveimage close postload
swap imagefilename overwrite saveimage close postload else drop then |; preservefp ;
else drop then factivate ;

View file

@ -1,5 +1,4 @@
: stdout ' putc task-emit ! ; : stdout ' putc task-emit ! ;
: withfp ( xt fp -- ) fdeactivate r> factivate execute fdeactivate drop r< factivate ;
: >rot <rot <rot ; : >rot <rot <rot ;
: 2dup over over ; : 2dup over over ;
@ -22,11 +21,9 @@
: expile state if , else execute then ; : expile state if , else execute then ;
' cells @ const $DOCOLON ( get the colon execution token )
: :noname here $DOCOLON , ] ; : :noname here $DOCOLON , ] ;
: :| inline| $DOCOLON , ; immediate : withfp ( xt fp -- ) :| factivate execute fdeactivate drop |; preservefp ;
: |; ' ret , |inline ; immediate
: array word new-word $DOVAR , ; : array word new-word $DOVAR , ;
: create word new-word $DOCREATE , 0 , ; : create word new-word $DOCREATE , 0 , ;
@ -57,6 +54,9 @@
: links begin yield @ dup not until ; : links begin yield @ dup not until ;
: files findfile begin dup while yield nextfile repeat ;
: .files files each type s" " type more ;
( usage: ( usage:
: search-xy { x y -- b r: coroutine } begin 2dup search >rot drop drop ; : search-xy { x y -- b r: coroutine } begin 2dup search >rot drop drop ;
: test-xy { x y -- b } : test-xy { x y -- b }

BIN
game.exe

Binary file not shown.

BIN
game.prj

Binary file not shown.

View file

@ -2,7 +2,7 @@
blah blah
s" game.log" open seekend fdeactivate const LOGFILE s" game.log" open seekend fdeactivate const LOGFILE
: emit-log fdeactivate LOGFILE factivate fputc fdeactivate drop factivate ; : emit-log ' fputc LOGFILE withfp ;
: atexit LOGFILE factivate close ; : atexit LOGFILE factivate close ;
: start-repl activate blah ' emit-log task-echo ! : start-repl activate blah ' emit-log task-echo !
@ -23,7 +23,6 @@ s" footer.jor" loadfile
s" map.jor" loadfile s" map.jor" loadfile
s" game.jor" loadfile s" game.jor" loadfile
s" state.jor" loadfile s" state.jor" loadfile
s" slide.jor" loadfile
; execute ; execute
intern pete.jor intern pete.jor
@ -35,4 +34,4 @@ intern trail1.jor
:noname loadfile ; checkpoint _loadlevel :noname loadfile ; checkpoint _loadlevel
' _loadlevel ' loadlevel redefine ' _loadlevel ' loadlevel redefine
( pete.jor loadlevel ) pete.jor loadlevel

20
jopl.c
View file

@ -26,24 +26,6 @@ static void f_quit() {
DONE = 1; DONE = 1;
} }
struct ffblk findfile;
void f_findfirst() {
int result = findfirst(TOP().s, &findfile, 0);
if (result == 0) {
PUSHS(findfile.ff_name);
} else {
PUSHU(0);
}
}
void f_findnext() {
int result = findnext(&findfile);
if (result == 0) {
PUSHS(findfile.ff_name);
} else {
PUSHU(0);
}
}
void f_keyWasPressed() { void f_keyWasPressed() {
int k = TOP().i; int k = TOP().i;
TOP().i = keyWasPressed(k); TOP().i = keyWasPressed(k);
@ -91,8 +73,6 @@ void do_repl(char *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("findnext", f_findnext);
CDEF("key-start", kbd_init); CDEF("key-start", kbd_init);
CDEF("key-end", kbd_cleanup); CDEF("key-end", kbd_cleanup);
CDEF("key-debounce", kbd_debounce); CDEF("key-debounce", kbd_debounce);

View file

@ -227,9 +227,6 @@ var t2
: ontick startt2 player status trackstatus ; : ontick startt2 player status trackstatus ;
: files findfile begin dup while yield findnext repeat ;
: .files files each type s" " type more ;
: keynote [ inline| : 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, 44 b, 31 b, 45 b, 32 b, 46 b, 47 b, 34 b, 48 b, 35 b, 49 b, 36 b, 50 b,
16 b, 3 b, 17 b, 4 b, 18 b, 19 b, 6 b, 20 b, 7 b, 21 b, 8 b, 22 b, 16 b, 3 b, 17 b, 4 b, 18 b, 19 b, 6 b, 20 b, 7 b, 21 b, 8 b, 22 b,

23
jorth.c
View file

@ -3,8 +3,8 @@
#include <stdio.h> #include <stdio.h>
#include <sys/stat.h> #include <sys/stat.h>
#include <dos.h> #include <dos.h>
#include <dir.h>
#include "jorth.h" #include "jorth.h"
#include "serial.h"
#define TASK_REGISTER_SIZE 3 #define TASK_REGISTER_SIZE 3
#define TASK_USER_SIZE 8 #define TASK_USER_SIZE 8
@ -757,6 +757,25 @@ void f_exists() {
TOP().i = rc == 0; TOP().i = rc == 0;
} }
struct ffblk findfile;
void f_findfirst() {
int result = findfirst(TOP().s, &findfile, 0);
if (result == 0) {
PUSHS(findfile.ff_name);
} else {
PUSHU(0);
}
}
void f_findnext() {
int result = findnext(&findfile);
if (result == 0) {
PUSHS(findfile.ff_name);
} else {
PUSHU(0);
}
}
void f_swapinput() { void f_swapinput() {
cell *key = RUNNING + TASK_USER_KEY; cell *key = RUNNING + TASK_USER_KEY;
cell *keysrc = RUNNING + TASK_USER_KEYSRC; cell *keysrc = RUNNING + TASK_USER_KEYSRC;
@ -1150,6 +1169,8 @@ void f_init(char *exe) {
CDEF("fget", f_fget); CDEF("fget", f_fget);
CDEF("fwrite", f_fwrite); CDEF("fwrite", f_fwrite);
CDEF("fread", f_fread); CDEF("fread", f_fread);
CDEF("findfile", f_findfirst);
CDEF("nextfile", f_findnext);
CDEF("imagefilename", f_imagefilename); CDEF("imagefilename", f_imagefilename);
CDEF("image-uptodate", f_image_up_to_date); CDEF("image-uptodate", f_image_up_to_date);
CDEF("loadimage", f_loadimage); CDEF("loadimage", f_loadimage);

View file

@ -1,32 +0,0 @@
( K E Y B O A R D )
1 const ^ESC
28 const ^ENTER
29 const ^CTRL
51 const ^<
52 const ^>
56 const ^ALT
57 const ^SPACE
72 const ^UP
75 const ^LEFT
77 const ^RIGHT
80 const ^DOWN
: wait-key ( k -- ) begin dup key-pressed not while suspend repeat drop ;
: udelta ( u u -- u )
2dup u> if
swap -1 swap - + 1 +
else
swap -
then ;
( M O U S E )
var prevbutton
: tick-debounce
mousebuttons prevbutton ! ;
1 const MOUSEL
2 const MOUSER
: mousedown ( button -- bool ) mousebuttons & ;
: clicked ( button -- bool )
dup mousedown not swap
prevbutton @ & and ;

BIN
slide.exe

Binary file not shown.

BIN
slide.prj

Binary file not shown.