Rewrote move-to to be usable from multiple tasks

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 ;

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 + ! ;

game.jor

@@ -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

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);

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

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();