promote "files" from jopl, words to simplify switching active files temporarily
This commit is contained in:
parent
64d421429e
commit
e96942da52
17
boot.jor
17
boot.jor
|
@ -28,6 +28,10 @@ key const sp
|
|||
: inline| ' INLINEDATA_ , here 0 , ;
|
||||
: |inline [ ' then , ] ;
|
||||
|
||||
' cells @ const $DOCOLON ( get the colon execution token )
|
||||
: :| inline| $DOCOLON , ; immediate
|
||||
: |; ' ret , |inline ; immediate
|
||||
|
||||
key " const '"'
|
||||
|
||||
: s" state if inline| else here then
|
||||
|
@ -83,13 +87,14 @@ defer onload
|
|||
: interpretjor ( filename -- )
|
||||
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 -- )
|
||||
( active file is preserved for the currently-loading file, but the
|
||||
new file is always loaded with no active files )
|
||||
fdeactivate swap
|
||||
dup loadimage-if-uptodate not if
|
||||
dup here swap interpretjor
|
||||
swap imagefilename overwrite saveimage close postload
|
||||
else drop then factivate ;
|
||||
:| dup loadimage-if-uptodate not if
|
||||
here over r> r> interpretjor
|
||||
r< r< imagefilename overwrite saveimage close postload
|
||||
else drop then |; preservefp ;
|
||||
|
|
8
defs.jor
8
defs.jor
|
@ -1,5 +1,4 @@
|
|||
: stdout ' putc task-emit ! ;
|
||||
: withfp ( xt fp -- ) fdeactivate r> factivate execute fdeactivate drop r< factivate ;
|
||||
|
||||
: >rot <rot <rot ;
|
||||
: 2dup over over ;
|
||||
|
@ -22,11 +21,9 @@
|
|||
|
||||
: expile state if , else execute then ;
|
||||
|
||||
' cells @ const $DOCOLON ( get the colon execution token )
|
||||
: :noname here $DOCOLON , ] ;
|
||||
|
||||
: :| inline| $DOCOLON , ; immediate
|
||||
: |; ' ret , |inline ; immediate
|
||||
: withfp ( xt fp -- ) :| factivate execute fdeactivate drop |; preservefp ;
|
||||
|
||||
: array word new-word $DOVAR , ;
|
||||
: create word new-word $DOCREATE , 0 , ;
|
||||
|
@ -57,6 +54,9 @@
|
|||
|
||||
: links begin yield @ dup not until ;
|
||||
|
||||
: files findfile begin dup while yield nextfile repeat ;
|
||||
: .files files each type s" " type more ;
|
||||
|
||||
( usage:
|
||||
: search-xy { x y -- b r: coroutine } begin 2dup search >rot drop drop ;
|
||||
: test-xy { x y -- b }
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
blah
|
||||
|
||||
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 ;
|
||||
|
||||
: start-repl activate blah ' emit-log task-echo !
|
||||
|
@ -23,7 +23,6 @@ s" footer.jor" loadfile
|
|||
s" map.jor" loadfile
|
||||
s" game.jor" loadfile
|
||||
s" state.jor" loadfile
|
||||
s" slide.jor" loadfile
|
||||
; execute
|
||||
|
||||
intern pete.jor
|
||||
|
@ -35,4 +34,4 @@ intern trail1.jor
|
|||
:noname loadfile ; checkpoint _loadlevel
|
||||
' _loadlevel ' loadlevel redefine
|
||||
|
||||
( pete.jor loadlevel )
|
||||
pete.jor loadlevel
|
||||
|
|
20
jopl.c
20
jopl.c
|
@ -26,24 +26,6 @@ static void f_quit() {
|
|||
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() {
|
||||
int k = TOP().i;
|
||||
TOP().i = keyWasPressed(k);
|
||||
|
@ -91,8 +73,6 @@ void do_repl(char *exe) {
|
|||
CDEF("_quit", f_quit);
|
||||
CDEF("adlib!", f_adlib_write);
|
||||
CDEF("adlib@", f_adlib_read);
|
||||
CDEF("findfile", f_findfirst);
|
||||
CDEF("findnext", f_findnext);
|
||||
CDEF("key-start", kbd_init);
|
||||
CDEF("key-end", kbd_cleanup);
|
||||
CDEF("key-debounce", kbd_debounce);
|
||||
|
|
3
jopl.jor
3
jopl.jor
|
@ -227,9 +227,6 @@ var t2
|
|||
|
||||
: ontick startt2 player status trackstatus ;
|
||||
|
||||
: files findfile begin dup while yield findnext repeat ;
|
||||
: .files files each type s" " type more ;
|
||||
|
||||
: 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,
|
||||
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
23
jorth.c
|
@ -3,8 +3,8 @@
|
|||
#include <stdio.h>
|
||||
#include <sys/stat.h>
|
||||
#include <dos.h>
|
||||
#include <dir.h>
|
||||
#include "jorth.h"
|
||||
#include "serial.h"
|
||||
|
||||
#define TASK_REGISTER_SIZE 3
|
||||
#define TASK_USER_SIZE 8
|
||||
|
@ -757,6 +757,25 @@ void f_exists() {
|
|||
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() {
|
||||
cell *key = RUNNING + TASK_USER_KEY;
|
||||
cell *keysrc = RUNNING + TASK_USER_KEYSRC;
|
||||
|
@ -1150,6 +1169,8 @@ void f_init(char *exe) {
|
|||
CDEF("fget", f_fget);
|
||||
CDEF("fwrite", f_fwrite);
|
||||
CDEF("fread", f_fread);
|
||||
CDEF("findfile", f_findfirst);
|
||||
CDEF("nextfile", f_findnext);
|
||||
CDEF("imagefilename", f_imagefilename);
|
||||
CDEF("image-uptodate", f_image_up_to_date);
|
||||
CDEF("loadimage", f_loadimage);
|
||||
|
|
32
keyboard.jor
32
keyboard.jor
|
@ -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 ;
|
Loading…
Reference in a new issue