Refactor file I/O to have implicit active file; add map load/save

This commit is contained in:
Jeremy Penner 2019-02-24 12:18:34 -05:00
parent 4881064908
commit 9ecb53ad57
9 changed files with 151 additions and 32 deletions

0
blart.map Executable file
View file

View file

@ -47,4 +47,4 @@ key " const '"'
begin word dup b@ while compileword repeat drop ; begin word dup b@ while compileword repeat drop ;
: load-input swap-input r> r> interpreter r< r< swap-input ; : load-input swap-input r> r> interpreter r< r< swap-input ;
: loadstring ' key-string load-input drop drop ; : loadstring ' key-string load-input drop drop ;
: loadfile ' key-file load-input drop close ; : loadfile fdeactivate ' key-file load-input drop close ;

View file

@ -1,11 +1,12 @@
: stdout ' putc task-emit ! ; : stdout ' putc task-emit ! ;
s" jorth.log" open const LOGFILE s" jorth.log" open seekend deactivate const LOGFILE
: log-emit LOGFILE fputc ; : withfp ( xt fp -- ) fdeactivate r> factivate execute fdeactivate drop r< factivate ;
: log-emit ' fputc LOGFILE withfp ;
: -rot rot rot ; : >rot <rot <rot ;
: 2dup over over ; : 2dup over over ;
: 3dup r> 2dup r@ -rot r< ; : 3dup r> 2dup r@ >rot r< ;
: 4dup r> r> 2dup r@ -rot rswap r@ -rot r< r< swap ; : 4dup r> r> 2dup r@ >rot rswap r@ >rot r< r< swap ;
: noop ; : noop ;
@ -18,6 +19,12 @@ s" jorth.log" open const LOGFILE
: defer word new-word docolon , ' noop , ' ret , ; : defer word new-word docolon , ' noop , ' ret , ;
: redefine ( cp cpdeferred ) cell + ! ; : redefine ( cp cpdeferred ) cell + ! ;
: for ( from to -- ) here ' r> , ' r> , ; immediate ( r: to from )
: i ' r@ , ; immediate
: next ' r< , 1 lit ' + , ' r< , ( from+1 to )
' 2dup , ' - , ' BNZ_ , ,
' drop , ' drop , ; immediate
: decompile : decompile
word lookup if 1 begin ( cp i ) word lookup if 1 begin ( cp i )
2dup cells + @ ( cp i @cp+i ) 2dup cells + @ ( cp i @cp+i )
@ -56,5 +63,5 @@ s" jorth.log" open const LOGFILE
: receive ( -- val ) : receive ( -- val )
running mailbox running mailbox
begin dup @ not while suspend repeat ( wait for mail ) begin dup @ not while suspend repeat ( wait for mail )
dup @ 0 rot ! ; dup @ 0 <rot ! ;

BIN
game.exe

Binary file not shown.

View file

@ -73,7 +73,7 @@ defentity player
: <range ( start range -- start end ) over + ; : <range ( start range -- start end ) over + ;
: lerpr ( start end ratio ) r> >range r< <ratio + ; : lerpr ( start end ratio ) r> >range r< <ratio + ;
: lerpn ( start1 end1 start2 end2 val ) : lerpn ( start1 end1 start2 end2 val )
r> >range r< rot - >ratio lerpr ; r> >range r< <rot - >ratio lerpr ;
: lerp ( start end duration start -- i ) : lerp ( start end duration start -- i )
ticks udelta ( start end duration delta ) ticks udelta ( start end duration delta )
>ratio lerpr ; >ratio lerpr ;
@ -90,21 +90,21 @@ var footer-y
: draw-footer footer-y @ split-screen ; : draw-footer footer-y @ split-screen ;
: text1 6 4 rot text ; : text1 6 4 <rot text ;
: text2 6 12 rot text ; : text2 6 12 <rot text ;
: clear s" " dup text1 text2 ; : clear s" " dup text1 text2 ;
: move-to ( p target speed -- ) : move-to ( target speed p -- )
rot dup r> @ -rot ticks ( from to duration start ) dup r> @ >rot ticks ( from to duration start )
begin begin
4dup lerp r@ ! 4dup lerp r@ !
rot dup r@ @ != ( from duration start to !done ) <rot dup r@ @ != ( from duration start to !done )
while while
-rot suspend >rot suspend
repeat rdrop drop drop drop drop ; repeat rdrop drop drop drop drop ;
: show-footer footer-y 24 10 move-to ; : show-footer 24 10 footer-y move-to ;
: hide-footer footer-y 0 10 move-to ; : hide-footer 0 10 footer-y move-to ;
: say1 ( s -- ) clear text1 show-footer ^ENTER wait-key ; : say1 ( s -- ) clear text1 show-footer ^ENTER wait-key ;
: say2 ( s1 s2 -- ) clear text2 text1 show-footer ^ENTER wait-key ; : say2 ( s1 s2 -- ) clear text2 text1 show-footer ^ENTER wait-key ;
@ -123,7 +123,7 @@ var prevbutton
( M A P ) ( M A P )
: +pos ( x1 y1 x2 y2 -- x y ) : +pos ( x1 y1 x2 y2 -- x y )
rot + rot rot + swap ; <rot + >rot + swap ;
var tileselect var tileselect
3 const MAXTILE 3 const MAXTILE
@ -142,6 +142,18 @@ var tileselect
MOUSEL mousedown if tileselect @ mousetile tile b! then ; MOUSEL mousedown if tileselect @ mousetile tile b! then ;
: save-map ( filename -- )
fdeactivate swap overwrite
mapsize swap fput fput
mapsize * map fwrite
factivate ;
: load-map ( filename -- )
fdeactivate swap open
fget fget
2dup * map fread
mapsize!
factivate ;
( J O B ) ( J O B )
var MODE-MOVE var MODE-MOVE
@ -164,7 +176,7 @@ JOB listen-for-jobs
player entity.dir @ dir>pos player entity.dir @ dir>pos
dup if swap drop player entity.y ( d v -- ) dup if swap drop player entity.y ( d v -- )
else drop player entity.x then else drop player entity.x then
swap 16 * over @ + 4 move-to ; swap 16 * over @ + 4 <rot move-to ;
: tick-player : tick-player
0 ^LEFT key-down if drop 1 W player entity.dir ! then 0 ^LEFT key-down if drop 1 W player entity.dir ! then

BIN
game.prj

Binary file not shown.

122
jorth.c
View file

@ -29,12 +29,10 @@ cell *TASKS = (cell*)mem;
cell *stack = ((cell*)mem) + STACK_OFFSET; cell *stack = ((cell*)mem) + STACK_OFFSET;
cell *rstack = ((cell*)mem) + RSTACK_OFFSET; cell *rstack = ((cell*)mem) + RSTACK_OFFSET;
char *INPUT = NULL;
FILE *INPUT_FILE = NULL;
FILE *OUTPUT_FILE = NULL;
#define QUIET (*(RUNNING + TASK_USER_QUIET)) #define QUIET (*(RUNNING + TASK_USER_QUIET))
FILE *ACTIVE_FILE = NULL;
void DROP(n) { void DROP(n) {
stack -= n; stack -= n;
if (stack < RUNNING + STACK_OFFSET) { if (stack < RUNNING + STACK_OFFSET) {
@ -292,10 +290,60 @@ void f_putc() {
} }
void f_fputc() { void f_fputc() {
fputc(ST1().i, TOP().fp); if (ACTIVE_FILE) {
fputc(TOP().i, ACTIVE_FILE);
}
DROP(1);
}
void f_fput() {
if (ACTIVE_FILE) {
fputc(TOP().u & 0xff, ACTIVE_FILE);
fputc((TOP().u >> 8) & 0xff, ACTIVE_FILE);
}
DROP(1);
}
void f_fwrite() { // ( length p )
if (ACTIVE_FILE) {
fwrite(TOP().p, ST1().u, 1, ACTIVE_FILE);
}
DROP(2); DROP(2);
} }
void f_fgetc() {
if (ACTIVE_FILE) {
PUSHI(fgetc(ACTIVE_FILE));
} else {
PUSHI(EOF);
}
}
void f_fget() {
if (ACTIVE_FILE) {
int low = fgetc(ACTIVE_FILE);
int high = fgetc(ACTIVE_FILE);
PUSHU(low | (high << 8));
} else {
PUSHU(0); // no way to signal EOF
}
}
void f_fread() { // ( length p )
if (ACTIVE_FILE) {
fread(TOP().p, ST1().u, 1, ACTIVE_FILE);
}
DROP(2);
}
void f_feof() {
if (ACTIVE_FILE) {
PUSHI(feof(ACTIVE_FILE));
} else {
PUSHI(1);
}
}
void f_puts() { void f_puts() {
char *s = TOP().s; char *s = TOP().s;
while (s && *s) { while (s && *s) {
@ -369,6 +417,7 @@ void f_cdef() { // func name --
} }
void f_docolon(); void f_docolon();
// C code must always call a colon word through f_cexecute() // C code must always call a colon word through f_cexecute()
void f_cexecute() { void f_cexecute() {
cell oldW = W; cell oldW = W;
@ -578,19 +627,52 @@ void f_interpreter() {
} }
} }
void f_open() { void f_close() {
FILE *fp = fopen(TOP().s, "a+"); if (ACTIVE_FILE) {
fseek(fp, 0, SEEK_SET); fclose(ACTIVE_FILE);
TOP().fp = fp; ACTIVE_FILE = NULL;
}
} }
void f_close() { void f_open() {
if (TOP().fp) { FILE *fp;
fclose(TOP().fp); f_close();
} fp = fopen(TOP().s, "a+");
fseek(fp, 0, SEEK_SET);
ACTIVE_FILE = fp;
DROP(1); DROP(1);
} }
void f_overwrite() {
f_close();
ACTIVE_FILE = fopen(TOP().s, "w+");
DROP(1);
}
void f_deactivate() {
PUSHP(ACTIVE_FILE);
ACTIVE_FILE = NULL;
}
void f_activate() {
f_close();
ACTIVE_FILE = TOP().fp;
DROP(1);
}
void f_seek() {
fseek(ACTIVE_FILE, TOP().u, SEEK_SET);
DROP(1);
}
void f_seekend() {
fseek(ACTIVE_FILE, 0, SEEK_END);
}
void f_tell() {
PUSHU(ftell(ACTIVE_FILE));
}
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;
@ -810,7 +892,7 @@ void f_init() {
CDEF("over", f_over); CDEF("over", f_over);
CDEF("drop", f_drop); CDEF("drop", f_drop);
CDEF("swap", f_swap); CDEF("swap", f_swap);
CDEF("rot", f_rot); CDEF("<rot", f_rot);
CDEF("r>", f_rput); CDEF("r>", f_rput);
CDEF("r<", f_rtake); CDEF("r<", f_rtake);
CDEF("r@", f_rtop); CDEF("r@", f_rtop);
@ -835,7 +917,18 @@ void f_init() {
CDEF(",", f_comma); CDEF(",", f_comma);
CDEF("b,", f_bcomma); CDEF("b,", f_bcomma);
CDEF("open", f_open); CDEF("open", f_open);
CDEF("overwrite", f_overwrite);
CDEF("close", f_close); CDEF("close", f_close);
CDEF("factivate", f_activate);
CDEF("fdeactivate", f_deactivate);
CDEF("seek", f_seek);
CDEF("seekend", f_seekend);
CDEF("fputc", f_fputc);
CDEF("fput", f_fput);
CDEF("fgetc", f_fgetc);
CDEF("fget", f_fget);
CDEF("fwrite", f_fwrite);
CDEF("fread", f_fread);
CDEF("quiet", f_quiet); CDEF("quiet", f_quiet);
CDEF("loud", f_loud); CDEF("loud", f_loud);
CDEF("task", f_task); CDEF("task", f_task);
@ -848,6 +941,7 @@ void f_init() {
PUSHS("boot.jor"); PUSHS("boot.jor");
f_open(); f_open();
f_deactivate();
PUSHS("key-file"); PUSHS("key-file");
f_lookup(); f_lookup();
DROP(1); DROP(1);

BIN
jorts.map Executable file

Binary file not shown.

View file

@ -158,6 +158,11 @@ void f_mapsize() { // ( -- w h )
PUSHI(screen.h); PUSHI(screen.h);
} }
void f_mapsize_set() { // ( w h -- )
loadMap(map, ST1().i, TOP().i);
DROP(2);
}
void f_mousepos() { // ( -- x y ) void f_mousepos() { // ( -- x y )
PUSHI(MOUSE.x); PUSHI(MOUSE.x);
PUSHI(MOUSE.y); PUSHI(MOUSE.y);
@ -180,6 +185,7 @@ void game_f_init() {
CDEF("text", f_text); CDEF("text", f_text);
CDEF("map", f_map); CDEF("map", f_map);
CDEF("mapsize", f_mapsize); CDEF("mapsize", f_mapsize);
CDEF("mapsize!", f_mapsize_set);
CDEF("mousepos", f_mousepos); CDEF("mousepos", f_mousepos);
CDEF("mousebuttons", f_mousebuttons); CDEF("mousebuttons", f_mousebuttons);