Rewrote move-to to be usable from multiple tasks

This commit is contained in:
Jeremy Penner 2019-02-24 10:14:56 -05:00
parent a876a9332f
commit 4881064908
8 changed files with 83 additions and 55 deletions

View file

@ -24,6 +24,15 @@ key const sp
: ( begin key ')' = until ; immediate
: lit ' LIT_ , , ;
: inline| ' INLINEDATA_ , here 0 , ;
: |inline [ ' then , ] ;
key " const '"'
: s" state if inline| else here then
begin key dup '"' != over 0 != and while b, repeat drop 0 b,
state if |inline else dup here! then ; immediate
: interpretword F_IMMEDIATE & state not or if execute else , then ;
: interpretnumber state if lit then ;
: interpretunknown type s" ?" type cr ;

View file

@ -2,12 +2,18 @@
s" jorth.log" open const LOGFILE
: log-emit LOGFILE fputc ;
: -rot rot rot ;
: 2dup over over ;
: 3dup r> 2dup r@ -rot r< ;
: 4dup r> r> 2dup r@ -rot rswap r@ -rot r< r< swap ;
: noop ;
' cells @ const docolon ( get the colon execution token )
: :noname here docolon , ] ;
: 2dup over over ;
: noop ;
: :| inline| :noname ; immediate
: |; ' ret , |inline ; immediate
: defer word new-word docolon , ' noop , ' ret , ;
: redefine ( cp cpdeferred ) cell + ! ;

BIN
game.exe

Binary file not shown.

View file

@ -74,8 +74,8 @@ defentity player
: lerpr ( start end ratio ) r> >range r< <ratio + ;
: lerpn ( start1 end1 start2 end2 val )
r> >range r< rot - >ratio lerpr ;
: lerp ( start end duration timer -- i )
@ ticks udelta ( start end duration delta )
: lerp ( start end duration start -- i )
ticks udelta ( start end duration delta )
>ratio lerpr ;
: triggered ( duration timer -- b )
@ -94,20 +94,14 @@ var footer-y
: text2 6 12 rot text ;
: clear s" " dup text1 text2 ;
( hmmm, todo: explicit "mover" struct with create does> ? )
var move-timer
var move-speed
: move-to ( p target speed -- )
move-speed ! swap dup r> @ swap ( from to -- )
move-timer now!
rot dup r> @ -rot ticks ( from to duration start )
begin
2dup move-speed @ move-timer lerp ( from to now -- )
dup r< dup r> !
over != ( from to -- )
4dup lerp r@ !
rot dup r@ @ != ( from duration start to !done )
while
suspend
repeat drop drop r< drop ;
-rot suspend
repeat rdrop drop drop drop drop ;
: show-footer footer-y 24 10 move-to ;
: hide-footer footer-y 0 10 move-to ;
@ -170,7 +164,7 @@ JOB listen-for-jobs
player entity.dir @ dir>pos
dup if swap drop player entity.y ( d v -- )
else drop player entity.x then
swap 16 * over @ + 5 move-to ;
swap 16 * over @ + 4 move-to ;
: tick-player
0 ^LEFT key-down if drop 1 W player entity.dir ! then

BIN
game.prj

Binary file not shown.

64
jorth.c
View file

@ -55,6 +55,10 @@ void f_here() {
PUSHCP(HERE);
}
void f_here_set() {
HERE = TOP().p;
DROP(1);
}
void f_latest() {
PUSHCP(LATEST);
}
@ -179,6 +183,21 @@ void f_rtake() {
PUSHC(*RPOP());
}
void f_rtop() {
PUSHC(*(rstack - 1));
}
void f_rdrop() {
RPOP();
}
void f_rswap() {
cell top = *(rstack - 1);
cell under = *(rstack - 2);
*(rstack - 1) = under;
*(rstack - 2) = top;
}
void f_cexecute();
void f_key_string() {
@ -638,40 +657,9 @@ void f_goto_() {
IP.p = IP.p->p;
}
void f_string_() {
PUSHP(IP.p + 1);
IP.p = CELL_OFFSET(IP.p + 1, IP.p->i + 1);
}
void f_string() {
cell *length;
char *s;
char b;
if (STATE.i) {
PUSHS("S\"_");
f_compileword();
length = HERE;
PUSHI(0);
f_comma();
}
s = (char*)HERE;
while(1) {
f_key();
b = TOP().i;
DROP(1);
if (b == '\"') {
*s++ = 0;
break;
} else {
*s++ = b;
}
}
if (STATE.i) {
length->i = (int)((s - ((char*)HERE)) - 1);
HERE = (cell *)s;
} else {
PUSHP(HERE);
}
void f_inline_data_() {
PUSHCP(IP.p + 1);
IP = *IP.p;
}
void f_quote() {
@ -773,6 +761,7 @@ void f_init() {
CDEF("execute", f_execute);
CDEF("new-word", f_create);
CDEF("here", f_here);
CDEF("here!", f_here_set);
CDEF("latest", f_latest);
CDEF("state", f_state);
CDEF("'", f_quote); f_immediate();
@ -824,7 +813,9 @@ void f_init() {
CDEF("rot", f_rot);
CDEF("r>", f_rput);
CDEF("r<", f_rtake);
CDEF("emit", f_emit);
CDEF("r@", f_rtop);
CDEF("rdrop", f_rdrop);
CDEF("rswap", f_rswap);
CDEF("task-emit", f_taskemit);
CDEF("task-echo", f_taskecho);
CDEF("swap-input", f_swapinput);
@ -835,6 +826,7 @@ void f_init() {
CDEF("GOTO_", f_goto_);
CDEF("BZ_", f_bz_);
CDEF("BNZ_", f_bnz_);
CDEF("INLINEDATA_", f_inline_data_);
CDEF("ret", f_ret);
CDEF(".", f_dot);
CDEF("u.", f_udot);
@ -842,8 +834,6 @@ void f_init() {
CDEF(".s", f_printstack);
CDEF(",", f_comma);
CDEF("b,", f_bcomma);
CDEF("s\"", f_string); f_immediate();
CDEF("S\"_", f_string_);
CDEF("open", f_open);
CDEF("close", f_close);
CDEF("quiet", f_quiet);

5
repl.jor Executable file
View file

@ -0,0 +1,5 @@
: start-repl activate ' putc task-emit !
s" .:: J O R T H ( jean forth) ::." type cr
begin receive loadstring s" ok" type cr again ;
task const REPL
REPL start-repl

View file

@ -213,7 +213,31 @@ void f_poll() {
}
}
int main() {
int DONE = 0;
static void f_quit() {
DONE = 1;
}
void do_repl() {
char buf[256];
f_init();
CDEF("quit", f_quit);
f_loadfile("repl.jor");
f_taskloop();
while (!DONE) {
PUSHS(gets(buf));
f_runstring("REPL send");
f_taskloop();
}
}
int main(int argc) {
if (argc > 1) {
do_repl();
return 0;
}
ser_init(SER_COM2, BAUD_19200, SER_8N1);
game_init();
game_f_init();