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 ')'
10 const '\n'
13 const '\r'
key const sp
128 const F_IMMEDIATE
@ -47,4 +48,18 @@ key " const '"'
begin word dup b@ while compileword repeat drop ;
: load-input swap-input r> r> interpreter r< r< swap-input ;
: 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 ! ;
s" jorth.log" open seekend deactivate const LOGFILE
: withfp ( xt fp -- ) fdeactivate r> factivate execute fdeactivate drop r< factivate ;
: log-emit ' fputc LOGFILE withfp ;
: >rot <rot <rot ;
: 2dup over over ;
@ -20,6 +18,8 @@ s" jorth.log" open seekend deactivate const LOGFILE
swap ! ;
: f@ ( v flag -- ) swap @ & ;
: expile state if , else execute then ;
' cells @ const $DOCOLON ( get the colon execution token )
: :noname here $DOCOLON , ] ;
@ -41,11 +41,14 @@ s" jorth.log" open seekend deactivate const LOGFILE
: +towards ( from to -- from+-1 )
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
: next ' r< , ' r@ , ' +towards , ( from+1 r: to )
' dup , ' r@ , ' = , ' BZ_ , ,
' rdrop , ' drop , ; immediate
: next
' r< , ' r@ , ' +towards , ( from+1 r: to )
[ ' repeat , ] ' drop , ' rdrop , ; immediate
: yield rswap ;
: each [ ' begin , ] ' dup , [ ' while , ] ; immediate
@ -53,7 +56,6 @@ s" jorth.log" open seekend deactivate const LOGFILE
: dobreak yield 0 ;
: break ' rdrop , ' dobreak , ; immediate
: min ( 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
' seremit task-emit !
' log-emit task-echo ! ;
' seremit task-emit !
: blah ' seremit task-emit ! ;
blah
: start-repl activate blah
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 ;
: now! ( timer -- ) ticks swap ! ;
: advance! ( timer -- delta )
dup @ ticks udelta ( timer delta )
dup <rot +! ;
( F O O T E R )
var footer-y
@ -135,15 +135,43 @@ var footer-y
var text-color
WHITE text-color !
: texty 7 swap <rot text-color @ text ;
: text0 10 texty ;
: text1 20 texty ;
: text2 30 texty ;
: statusy 7 swap <rot text-color @ text ;
: status0 10 statusy ;
: status1 20 statusy ;
: 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
text-color @
WHITE text-color !
s" " dup dup text0 text1 text2
text-color ! ;
s" " dup dup status0 status1 status2
text-color !
7 textx !
10 texty ! ;
: move-to ( target speed p -- )
dup r> @ >rot ticks ( from to duration start )
@ -159,10 +187,8 @@ WHITE text-color !
: footer-wait show-footer ^ENTER wait-key ;
( todo: generic say" that handles newlines, gradual text display )
: say1 ( s -- ) clear text1 footer-wait ;
: say2 ( s1 s2 -- ) clear text1 text0 footer-wait ;
: say3 ( s1 s2 s3 -- ) clear text2 text1 text0 footer-wait ;
: say ( s -- ) clear show-footer slowtext footer-wait ;
: say" [ ' s" , ] ' say expile ; immediate
: character ( iportrait color ) create , ,
does> dup @ text-color ! cell + @ draw-portrait ;
@ -294,6 +320,10 @@ defer 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 -- )
dup entity.dir @ dir>pos ( e dx dy )
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 ;
: try-move-player
player entity.dir @ dir>pos
player entity.x @ player entity.y @ world>tile +pos ( x y )
check-player-touch not if move-player then ;
player entity-dst 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
0 ^LEFT key-down if drop 1 W player entity.dir ! then
@ -335,8 +371,8 @@ player :tick
( S T U F F )
: hello-world
s" Hello, world!" say1
s" How are you" s" today?" say2
mary say" Hello, world!"
say" How are you\today?"
player.state DRIVING f@ not player.state DRIVING f! ;
: mode-move
@ -376,9 +412,10 @@ var cartimer
cartimer now!
car :tick 60 cartimer triggered if
:| car entity.dir @ E = if W else E then car entity.dir !
car move-entity |; JOB send
car try-move-entity |; JOB send
then
:touch pete s" What an old rustbucket." say1
:touch pete say" What an old rustbucket.
Hasn't driven in years."
;entity
:noname

BIN
game.prj

Binary file not shown.

128
jorth.c
View file

@ -1,4 +1,5 @@
#include <stdio.h>
#include <sys/stat.h>
#include "jorth.h"
#include "serial.h"
@ -80,7 +81,7 @@ BINOP(f_add, i, +)
BINOP(f_sub, i, -)
BINOP(f_mul, i, *)
BINOP(f_div, i, /)
BINOP(f_mod, i, %)
BINOP(f_mod, u, %)
BINOP(f_eq, i, ==)
BINOP(f_neq, i, !=)
BINOP(f_ge, i, >=)
@ -314,22 +315,21 @@ void f_fwrite() { // ( length p )
void f_fgetc() {
int result = EOF;
if (ACTIVE_FILE) {
char byte = 0;
if (fread(&byte, 1, 1, ACTIVE_FILE) == 1) {
result = byte;
}
result = fgetc(ACTIVE_FILE);
}
PUSHI(result);
}
void f_fget() {
unsigned int result = 0;
if (ACTIVE_FILE) {
int result = 0;
fread(&result, 2, 1, ACTIVE_FILE);
PUSHU(result);
} else {
PUSHU(0); // no way to signal EOF
int low = fgetc(ACTIVE_FILE);
int high = fgetc(ACTIVE_FILE);
if (low != EOF && high != EOF) {
result = low | (high << 8);
}
}
PUSHU(result);
}
void f_fread() { // ( length p )
@ -641,7 +641,6 @@ void f_close() {
void f_open() {
FILE *fp;
f_close();
fp = fopen(TOP().s, "ab+");
fseek(fp, 0, SEEK_SET);
ACTIVE_FILE = fp;
@ -769,16 +768,105 @@ void f_quote() {
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) {
PUSHS(filename);
f_open();
PUSHS("loadfile");
f_lookup();
DROP(1);
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) {
PUSHS(s);
PUSHS("loadstring");
@ -946,6 +1034,10 @@ void f_init() {
CDEF("fget", f_fget);
CDEF("fwrite", f_fwrite);
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("quiet", f_quiet);
CDEF("loud", f_loud);
@ -960,17 +1052,7 @@ void f_init() {
PCONST("$DOVAR", f_dovar);
PCONST("$DODEFERRED", f_dodeferred);
PUSHS("boot.jor");
f_open();
f_deactivate();
PUSHS("key-file");
f_lookup();
DROP(1);
f_swapinput();
f_interpreter();
f_swapinput();
DROP(2);
f_loadfile_cterp("boot.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);
}
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 -- )
setWriteMode(0);
@ -199,6 +206,7 @@ void game_f_init() {
CDEF("split-screen", f_splitscreen);
CDEF("ticks", f_ticks);
CDEF("text", f_text);
CDEF("textc", f_textc);
CDEF("map", f_map);
CDEF("mapsize", f_mapsize);
CDEF("mapsize!", f_mapsize_set);