Text animations, save memory to .jim files post-load to speed startup
This commit is contained in:
parent
1381c10d93
commit
ad0f3fbf6c
17
boot.jor
17
boot.jor
|
@ -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 ;
|
||||||
|
|
16
defs.jor
16
defs.jor
|
@ -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 ;
|
||||||
|
|
||||||
|
|
81
game.jor
81
game.jor
|
@ -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
|
||||||
|
|
128
jorth.c
128
jorth.c
|
@ -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");
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -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);
|
||||||
|
|
Loading…
Reference in a new issue