Text animations, save memory to .jim files post-load to speed startup

This commit is contained in:
Jeremy Penner 2019-03-05 17:35:50 -05:00
parent 1381c10d93
commit ad0f3fbf6c
13 changed files with 197 additions and 53 deletions

BIN
boot.img Executable file

Binary file not shown.

BIN
boot.jim Executable file

Binary file not shown.

View file

@ -4,6 +4,7 @@
key ) const ')' key ) const ')'
10 const '\n' 10 const '\n'
13 const '\r'
key const sp key const sp
128 const F_IMMEDIATE 128 const F_IMMEDIATE
@ -47,4 +48,18 @@ 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 fdeactivate ' key-file load-input drop close ;
: loadimage-if-uptodate ( filename -- b )
dup image-uptodate if imagefilename open loadimage close else drop 0 then ;
: loadjor ( filename -- )
open fdeactivate ' key-file load-input drop factivate close ;
: 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 loadjor
swap imagefilename overwrite saveimage close
else drop then factivate ;

BIN
defs.jim Executable file

Binary file not shown.

View file

@ -1,7 +1,5 @@
: stdout ' putc task-emit ! ; : stdout ' putc task-emit ! ;
s" jorth.log" open seekend deactivate const LOGFILE
: withfp ( xt fp -- ) fdeactivate r> factivate execute fdeactivate drop r< factivate ; : 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 ;
@ -20,6 +18,8 @@ s" jorth.log" open seekend deactivate const LOGFILE
swap ! ; swap ! ;
: f@ ( v flag -- ) swap @ & ; : f@ ( v flag -- ) swap @ & ;
: expile state if , else execute then ;
' cells @ const $DOCOLON ( get the colon execution token ) ' cells @ const $DOCOLON ( get the colon execution token )
: :noname here $DOCOLON , ] ; : :noname here $DOCOLON , ] ;
@ -41,11 +41,14 @@ s" jorth.log" open seekend deactivate const LOGFILE
: +towards ( from to -- from+-1 ) : +towards ( from to -- from+-1 )
over > if 1 + else 1 - then ; over > if 1 + else 1 - then ;
: for ( from to -- ) ' r> , here ' r> , ; immediate ( r: to from ) : for ( from to -- )
' r> , [ ' begin , ] ( from r: to )
' dup , ' r@ , ' != , [ ' while , ]
' r> , ; immediate ( r: to from )
: i ' r@ , ; immediate : i ' r@ , ; immediate
: next ' r< , ' r@ , ' +towards , ( from+1 r: to ) : next
' dup , ' r@ , ' = , ' BZ_ , , ' r< , ' r@ , ' +towards , ( from+1 r: to )
' rdrop , ' drop , ; immediate [ ' repeat , ] ' drop , ' rdrop , ; immediate
: yield rswap ; : yield rswap ;
: each [ ' begin , ] ' dup , [ ' while , ] ; immediate : each [ ' begin , ] ' dup , [ ' while , ] ; immediate
@ -53,7 +56,6 @@ s" jorth.log" open seekend deactivate const LOGFILE
: dobreak yield 0 ; : dobreak yield 0 ;
: break ' rdrop , ' dobreak , ; immediate : break ' rdrop , ' dobreak , ; immediate
: min ( x y -- x|y ) 2dup > if swap then drop ; : min ( x y -- x|y ) 2dup > if swap then drop ;
: max ( x y -- x|y ) 2dup < if swap then drop ; : max ( x y -- x|y ) 2dup < if swap then drop ;

BIN
game.exe

Binary file not shown.

BIN
game.img Executable file

Binary file not shown.

BIN
game.jim Executable file

Binary file not shown.

View file

@ -1,8 +1,5 @@
: blah : blah ' seremit task-emit ! ;
' seremit task-emit ! blah
' log-emit task-echo ! ;
' seremit task-emit !
: start-repl activate blah : start-repl activate blah
s" .:: J O R T H ( jean forth) ::." type cr s" .:: J O R T H ( jean forth) ::." type cr
@ -108,6 +105,9 @@ array frames
2dup <= if drop r< +! 1 else drop drop rdrop 0 then ; 2dup <= if drop r< +! 1 else drop drop rdrop 0 then ;
: now! ( timer -- ) ticks swap ! ; : now! ( timer -- ) ticks swap ! ;
: advance! ( timer -- delta )
dup @ ticks udelta ( timer delta )
dup <rot +! ;
( F O O T E R ) ( F O O T E R )
var footer-y var footer-y
@ -135,15 +135,43 @@ var footer-y
var text-color var text-color
WHITE text-color ! WHITE text-color !
: texty 7 swap <rot text-color @ text ; : statusy 7 swap <rot text-color @ text ;
: text0 10 texty ; : status0 10 statusy ;
: text1 20 texty ; : status1 20 statusy ;
: text2 30 texty ; : status2 30 statusy ;
var textx
var texty
2 const textspeed
: nltext 7 textx ! 10 texty +! ;
: inctextx
textx @ 1 + dup 38 <= if textx !
else drop nltext then ;
key \ const '\'
: statusc
dup dup '\' = swap '\n' = or if drop nltext
else dup '\r' = if drop
else textx @ texty @ <rot text-color @ textc inctextx then then ;
var texttimer
: textnextc ( s -- s )
dup b@ dup if statusc 1 + else drop then ;
: slowtext ( s -- )
texttimer now!
begin dup b@ while
texttimer advance! textspeed * 0 for textnextc next
suspend repeat drop ;
: clear : clear
text-color @ text-color @
WHITE text-color ! WHITE text-color !
s" " dup dup text0 text1 text2 s" " dup dup status0 status1 status2
text-color ! ; text-color !
7 textx !
10 texty ! ;
: move-to ( target speed p -- ) : move-to ( target speed p -- )
dup r> @ >rot ticks ( from to duration start ) dup r> @ >rot ticks ( from to duration start )
@ -159,10 +187,8 @@ WHITE text-color !
: footer-wait show-footer ^ENTER wait-key ; : footer-wait show-footer ^ENTER wait-key ;
( todo: generic say" that handles newlines, gradual text display ) : say ( s -- ) clear show-footer slowtext footer-wait ;
: say1 ( s -- ) clear text1 footer-wait ; : say" [ ' s" , ] ' say expile ; immediate
: say2 ( s1 s2 -- ) clear text1 text0 footer-wait ;
: say3 ( s1 s2 s3 -- ) clear text2 text1 text0 footer-wait ;
: character ( iportrait color ) create , , : character ( iportrait color ) create , ,
does> dup @ text-color ! cell + @ draw-portrait ; does> dup @ text-color ! cell + @ draw-portrait ;
@ -294,6 +320,10 @@ defer player
12 9 N ' {player} defentity player 12 9 N ' {player} defentity player
: entity-dst ( e -- x y )
r> r@ entity.dir @ dir>pos
r@ entity.x @ r< entity.y @ world>tile +pos ;
: move-entity ( e -- ) : move-entity ( e -- )
dup entity.dir @ dir>pos ( e dx dy ) dup entity.dir @ dir>pos ( e dx dy )
dup if swap drop swap entity.y dup if swap drop swap entity.y
@ -321,9 +351,15 @@ defer player-touch ( x y -- b )
player.canmove? if 0 else 1 then then then then ; player.canmove? if 0 else 1 then then then then ;
: try-move-player : try-move-player
player entity.dir @ dir>pos player entity-dst check-player-touch not if move-player then ;
player entity.x @ player entity.y @ world>tile +pos ( x y )
check-player-touch not if move-player then ; : check-entity-touch ( x y -- b )
2dup entity-at if drop drop 1 else
2dup out-of-bounds if 1 else
WALKABLE mapflag? if 0 else 1 then then then ;
: try-move-entity ( e -- )
dup entity-dst check-entity-touch not if move-entity then ;
player :tick player :tick
0 ^LEFT key-down if drop 1 W player entity.dir ! then 0 ^LEFT key-down if drop 1 W player entity.dir ! then
@ -335,8 +371,8 @@ player :tick
( S T U F F ) ( S T U F F )
: hello-world : hello-world
s" Hello, world!" say1 mary say" Hello, world!"
s" How are you" s" today?" say2 say" How are you\today?"
player.state DRIVING f@ not player.state DRIVING f! ; player.state DRIVING f@ not player.state DRIVING f! ;
: mode-move : mode-move
@ -376,9 +412,10 @@ var cartimer
cartimer now! cartimer now!
car :tick 60 cartimer triggered if car :tick 60 cartimer triggered if
:| car entity.dir @ E = if W else E then car entity.dir ! :| car entity.dir @ E = if W else E then car entity.dir !
car move-entity |; JOB send car try-move-entity |; JOB send
then then
:touch pete s" What an old rustbucket." say1 :touch pete say" What an old rustbucket.
Hasn't driven in years."
;entity ;entity
:noname :noname

BIN
game.prj

Binary file not shown.

128
jorth.c
View file

@ -1,4 +1,5 @@
#include <stdio.h> #include <stdio.h>
#include <sys/stat.h>
#include "jorth.h" #include "jorth.h"
#include "serial.h" #include "serial.h"
@ -80,7 +81,7 @@ BINOP(f_add, i, +)
BINOP(f_sub, i, -) BINOP(f_sub, i, -)
BINOP(f_mul, i, *) BINOP(f_mul, i, *)
BINOP(f_div, i, /) BINOP(f_div, i, /)
BINOP(f_mod, i, %) BINOP(f_mod, u, %)
BINOP(f_eq, i, ==) BINOP(f_eq, i, ==)
BINOP(f_neq, i, !=) BINOP(f_neq, i, !=)
BINOP(f_ge, i, >=) BINOP(f_ge, i, >=)
@ -314,22 +315,21 @@ void f_fwrite() { // ( length p )
void f_fgetc() { void f_fgetc() {
int result = EOF; int result = EOF;
if (ACTIVE_FILE) { if (ACTIVE_FILE) {
char byte = 0; result = fgetc(ACTIVE_FILE);
if (fread(&byte, 1, 1, ACTIVE_FILE) == 1) {
result = byte;
}
} }
PUSHI(result); PUSHI(result);
} }
void f_fget() { void f_fget() {
unsigned int result = 0;
if (ACTIVE_FILE) { if (ACTIVE_FILE) {
int result = 0; int low = fgetc(ACTIVE_FILE);
fread(&result, 2, 1, ACTIVE_FILE); int high = fgetc(ACTIVE_FILE);
PUSHU(result); if (low != EOF && high != EOF) {
} else { result = low | (high << 8);
PUSHU(0); // no way to signal EOF
} }
}
PUSHU(result);
} }
void f_fread() { // ( length p ) void f_fread() { // ( length p )
@ -641,7 +641,6 @@ void f_close() {
void f_open() { void f_open() {
FILE *fp; FILE *fp;
f_close();
fp = fopen(TOP().s, "ab+"); fp = fopen(TOP().s, "ab+");
fseek(fp, 0, SEEK_SET); fseek(fp, 0, SEEK_SET);
ACTIVE_FILE = fp; ACTIVE_FILE = fp;
@ -769,16 +768,105 @@ void f_quote() {
DROP(1); DROP(1);
} }
} }
void f_imagefilename() {
static char imagefilename[32];
int i;
strcpy(imagefilename, TOP().s);
for (i = 0; i < strlen(imagefilename); i ++) {
if (imagefilename[i] == '.') break;
}
strcpy(&imagefilename[i], ".jim");
TOP().s = imagefilename;
}
void f_image_up_to_date() {
struct stat src, img;
int uptodate = 0;
f_dup();
f_imagefilename();
if (stat(TOP().s, &img) == 0 && stat(ST1().s, &src) == 0) {
uptodate = img.st_mtime > src.st_mtime;
}
DROP(1);
TOP().i = uptodate;
}
void f_loadimage() {
cell *start, *latestNew, *tasksNew;
size_t size;
fread(&start, sizeof(cell *), 1, ACTIVE_FILE);
fread(&latestNew, sizeof(cell *), 1, ACTIVE_FILE);
fread(&tasksNew, sizeof(cell *), 1, ACTIVE_FILE);
fread(&size, sizeof(size_t), 1, ACTIVE_FILE);
if (start != HERE) {
fseek(ACTIVE_FILE, size, SEEK_CUR);
PUSHI(0);
} else {
fread(HERE, 1, size, ACTIVE_FILE);
HERE = CELL_OFFSET(HERE, size);
LATEST = latestNew;
TASKS = tasksNew;
PUSHI(1);
}
}
void f_saveimage() {
size_t size = (size_t)(((char*)HERE) - TOP().s);
fwrite(&TOP().p, sizeof(cell *), 1, ACTIVE_FILE);
fwrite(&LATEST, sizeof(cell *), 1, ACTIVE_FILE);
fwrite(&TASKS, sizeof(cell *), 1, ACTIVE_FILE);
fwrite(&size, sizeof(size_t), 1, ACTIVE_FILE);
fwrite(TOP().p, 1, size, ACTIVE_FILE);
DROP(1);
}
void f_loadfile(char *filename) { void f_loadfile(char *filename) {
PUSHS(filename); PUSHS(filename);
f_open();
PUSHS("loadfile"); PUSHS("loadfile");
f_lookup(); f_lookup();
DROP(1); DROP(1);
f_cexecute(); f_cexecute();
} }
// does not use the jorth interpreter defined in boot.jor
void f_loadfile_cterp(char *filename) {
cell *start = HERE;
PUSHS(filename);
f_dup();
f_image_up_to_date();
if (TOP().i) {
DROP(1);
f_dup();
f_imagefilename();
f_open();
f_loadimage();
f_close();
if (TOP().i) {
DROP(2);
return;
}
}
DROP(1);
f_open();
f_deactivate();
PUSHS("key-file");
f_lookup();
DROP(1);
f_swapinput();
f_interpreter();
f_swapinput();
DROP(2);
PUSHS(filename);
f_imagefilename();
f_overwrite();
PUSHCP(start);
f_saveimage();
f_close();
}
void f_runstring(char *s) { void f_runstring(char *s) {
PUSHS(s); PUSHS(s);
PUSHS("loadstring"); PUSHS("loadstring");
@ -946,6 +1034,10 @@ void f_init() {
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("imagefilename", f_imagefilename);
CDEF("image-uptodate", f_image_up_to_date);
CDEF("loadimage", f_loadimage);
CDEF("saveimage", f_saveimage);
CDEF("memmove", f_memmove); CDEF("memmove", f_memmove);
CDEF("quiet", f_quiet); CDEF("quiet", f_quiet);
CDEF("loud", f_loud); CDEF("loud", f_loud);
@ -960,17 +1052,7 @@ void f_init() {
PCONST("$DOVAR", f_dovar); PCONST("$DOVAR", f_dovar);
PCONST("$DODEFERRED", f_dodeferred); PCONST("$DODEFERRED", f_dodeferred);
PUSHS("boot.jor"); f_loadfile_cterp("boot.jor");
f_open();
f_deactivate();
PUSHS("key-file");
f_lookup();
DROP(1);
f_swapinput();
f_interpreter();
f_swapinput();
DROP(2);
f_loadfile("defs.jor"); f_loadfile("defs.jor");
} }

BIN
jorth.img Executable file

Binary file not shown.

View file

@ -148,6 +148,13 @@ void f_splitscreen() {
DROP(1); DROP(1);
} }
void f_textc() { // ( col line c color -- )
setWriteMode(0);
setPlaneColor(TOP().u);
DROP(1);
text_draw_char(ST2().u + (ST1().u * PAGE_STRIDE), TOP().i);
DROP(3);
}
void f_text() { // ( col line s color -- ) void f_text() { // ( col line s color -- )
setWriteMode(0); setWriteMode(0);
@ -199,6 +206,7 @@ void game_f_init() {
CDEF("split-screen", f_splitscreen); CDEF("split-screen", f_splitscreen);
CDEF("ticks", f_ticks); CDEF("ticks", f_ticks);
CDEF("text", f_text); CDEF("text", f_text);
CDEF("textc", f_textc);
CDEF("map", f_map); CDEF("map", f_map);
CDEF("mapsize", f_mapsize); CDEF("mapsize", f_mapsize);
CDEF("mapsize!", f_mapsize_set); CDEF("mapsize!", f_mapsize_set);