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 ')'
|
||||
|
||||
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 ;
|
||||
|
|
16
defs.jor
16
defs.jor
|
@ -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 ;
|
||||
|
||||
|
|
81
game.jor
81
game.jor
|
@ -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
|
||||
|
|
128
jorth.c
128
jorth.c
|
@ -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");
|
||||
}
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
|
Loading…
Reference in a new issue