diff --git a/boot.jor b/boot.jor index 2d3e63e..9ed64a2 100755 --- a/boot.jor +++ b/boot.jor @@ -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 ; diff --git a/defs.jor b/defs.jor index 360ce80..d822746 100755 --- a/defs.jor +++ b/defs.jor @@ -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 + ! ; diff --git a/game.exe b/game.exe index 956badc..8c930d6 100755 Binary files a/game.exe and b/game.exe differ diff --git a/game.jor b/game.jor index 0968b20..ec9d397 100755 --- a/game.jor +++ b/game.jor @@ -74,8 +74,8 @@ defentity player : lerpr ( start end ratio ) r> >range 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 diff --git a/game.prj b/game.prj index 9889ef2..70a93fd 100755 Binary files a/game.prj and b/game.prj differ diff --git a/jorth.c b/jorth.c index 19f81a9..9199b31 100755 --- a/jorth.c +++ b/jorth.c @@ -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); diff --git a/repl.jor b/repl.jor new file mode 100755 index 0000000..35dee6b --- /dev/null +++ b/repl.jor @@ -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 diff --git a/testbed.c b/testbed.c index 0db6ec9..5c44ac8 100755 --- a/testbed.c +++ b/testbed.c @@ -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();