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| ' 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 ;
|
|
||||||
|
|
8
defs.jor
8
defs.jor
|
@ -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 }
|
||||||
|
|
|
@ -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
20
jopl.c
|
@ -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);
|
||||||
|
|
3
jopl.jor
3
jopl.jor
|
@ -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
23
jorth.c
|
@ -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);
|
||||||
|
|
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