Refactor file I/O to have implicit active file; add map load/save

boot.jor

@@ -47,4 +47,4 @@ 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 ' key-file load-input drop close ;
+: loadfile fdeactivate ' key-file load-input drop close ;

defs.jor

@@ -1,11 +1,12 @@
 : stdout ' putc task-emit ! ;
-s" jorth.log" open const LOGFILE
-: log-emit LOGFILE fputc ;
+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 ;
+: >rot <rot <rot ;
 : 2dup over over ;
-: 3dup r> 2dup r@ -rot r< ;
-: 4dup r> r> 2dup r@ -rot rswap r@ -rot r< r< swap ;
+: 3dup r> 2dup r@ >rot r< ;
+: 4dup r> r> 2dup r@ >rot rswap r@ >rot r< r< swap ;
 
 : noop ;
 
@@ -18,6 +19,12 @@ s" jorth.log" open const LOGFILE
 : defer word new-word docolon , ' noop , ' ret , ;
 : redefine ( cp cpdeferred ) cell + ! ;
 
+: for ( from to -- ) here ' r> , ' r> , ; immediate ( r: to from )
+: i ' r@ , ; immediate
+: next ' r< , 1 lit ' + , ' r< , ( from+1 to )
+       ' 2dup , ' - , ' BNZ_ , ,
+       ' drop , ' drop , ; immediate
+
 : decompile
   word lookup if 1 begin ( cp i )
     2dup cells + @ ( cp i @cp+i )
@@ -56,5 +63,5 @@ s" jorth.log" open const LOGFILE
 : receive ( -- val )
   running mailbox
   begin dup @ not while suspend repeat ( wait for mail )
-  dup @ 0 rot ! ;
+  dup @ 0 <rot ! ;
 

game.jor

@@ -73,7 +73,7 @@ defentity player
 : <range ( start range -- start end ) over + ;
 : lerpr ( start end ratio ) r> >range r< <ratio + ;
 : lerpn ( start1 end1 start2 end2 val )
-  r> >range r< rot - >ratio lerpr ;
+  r> >range r< <rot - >ratio lerpr ;
 : lerp ( start end duration start -- i )
   ticks udelta ( start end duration delta )
   >ratio lerpr ;
@@ -90,21 +90,21 @@ var footer-y
 
 : draw-footer footer-y @ split-screen ;
 
-: text1 6 4 rot text ;
-: text2 6 12 rot text ;
+: text1 6 4 <rot text ;
+: text2 6 12 <rot text ;
 : clear s"                                 " dup text1 text2 ;
 
-: move-to ( p target speed -- )
-  rot dup r> @ -rot ticks ( from to duration start )
+: move-to ( target speed p -- )
+  dup r> @ >rot ticks ( from to duration start )
   begin
     4dup lerp r@ !
-    rot dup r@ @ != ( from duration start to !done )
+    <rot dup r@ @ != ( from duration start to !done )
   while
-    -rot suspend
+    >rot suspend
   repeat rdrop drop drop drop drop ;
 
-: show-footer footer-y 24 10 move-to ;
-: hide-footer footer-y 0 10 move-to ;
+: show-footer 24 10 footer-y move-to ;
+: hide-footer 0 10 footer-y move-to ;
 
 : say1 ( s -- ) clear text1 show-footer ^ENTER wait-key ;
 : say2 ( s1 s2 -- ) clear text2 text1 show-footer ^ENTER wait-key ;
@@ -123,7 +123,7 @@ var prevbutton
 
 ( M A P )
 : +pos ( x1 y1 x2 y2 -- x y )
-  rot + rot rot + swap ;
+  <rot + >rot + swap ;
 
 var tileselect
 3 const MAXTILE
@@ -142,6 +142,18 @@ var tileselect
 
   MOUSEL mousedown if tileselect @ mousetile tile b! then ;
 
+: save-map ( filename -- )
+  fdeactivate swap overwrite
+  mapsize swap fput fput
+  mapsize * map fwrite
+  factivate ;
+
+: load-map ( filename -- )
+  fdeactivate swap open
+  fget fget
+  2dup * map fread
+  mapsize!
+  factivate ;
 
 ( J O B )
 var MODE-MOVE
@@ -164,7 +176,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 @ + 4 move-to ;
+  swap 16 * over @ + 4 <rot move-to ;
 
 : tick-player
   0 ^LEFT key-down if drop 1 W player entity.dir ! then

jorth.c

@@ -29,12 +29,10 @@ cell *TASKS = (cell*)mem;
 cell *stack = ((cell*)mem) + STACK_OFFSET;
 cell *rstack = ((cell*)mem) + RSTACK_OFFSET;
 
-char *INPUT = NULL;
-FILE *INPUT_FILE = NULL;
-
-FILE *OUTPUT_FILE = NULL;
 #define QUIET (*(RUNNING + TASK_USER_QUIET))
 
+FILE *ACTIVE_FILE = NULL;
+
 void DROP(n) {
   stack -= n;
   if (stack < RUNNING + STACK_OFFSET) {
@@ -292,10 +290,60 @@ void f_putc() {
 }
 
 void f_fputc() {
-  fputc(ST1().i, TOP().fp);
+  if (ACTIVE_FILE) {
+    fputc(TOP().i, ACTIVE_FILE);
+  }
+  DROP(1);
+}
+
+void f_fput() {
+  if (ACTIVE_FILE) {
+    fputc(TOP().u & 0xff, ACTIVE_FILE);
+    fputc((TOP().u >> 8) & 0xff, ACTIVE_FILE);
+  }
+  DROP(1);
+}
+
+void f_fwrite() { // ( length p )
+  if (ACTIVE_FILE) {
+    fwrite(TOP().p, ST1().u, 1, ACTIVE_FILE);
+  }
   DROP(2);
 }
 
+void f_fgetc() {
+  if (ACTIVE_FILE) {
+    PUSHI(fgetc(ACTIVE_FILE));
+  } else {
+    PUSHI(EOF);
+  }
+}
+
+void f_fget() {
+  if (ACTIVE_FILE) {
+    int low = fgetc(ACTIVE_FILE);
+    int high = fgetc(ACTIVE_FILE);
+    PUSHU(low | (high << 8));
+  } else {
+    PUSHU(0); // no way to signal EOF
+  }
+}
+
+void f_fread() { // ( length p )
+  if (ACTIVE_FILE) {
+    fread(TOP().p, ST1().u, 1, ACTIVE_FILE);
+  }
+  DROP(2);
+}
+
+void f_feof() {
+  if (ACTIVE_FILE) {
+    PUSHI(feof(ACTIVE_FILE));
+  } else {
+    PUSHI(1);
+  }
+}
+
 void f_puts() {
   char *s = TOP().s;
   while (s && *s) {
@@ -369,6 +417,7 @@ void f_cdef() { // func name --
 }
 
 void f_docolon();
+
 // C code must always call a colon word through f_cexecute()
 void f_cexecute() {
   cell oldW = W;
@@ -578,19 +627,52 @@ void f_interpreter() {
   }
 }
 
-void f_open() {
-  FILE *fp = fopen(TOP().s, "a+");
-  fseek(fp, 0, SEEK_SET);
-  TOP().fp = fp;
+void f_close() {
+  if (ACTIVE_FILE) {
+    fclose(ACTIVE_FILE);
+    ACTIVE_FILE = NULL;
+  }
 }
 
-void f_close() {
-  if (TOP().fp) {
-    fclose(TOP().fp);
-  }
+void f_open() {
+  FILE *fp;
+  f_close();
+  fp = fopen(TOP().s, "a+");
+  fseek(fp, 0, SEEK_SET);
+  ACTIVE_FILE = fp;
   DROP(1);
 }
 
+void f_overwrite() {
+  f_close();
+  ACTIVE_FILE = fopen(TOP().s, "w+");
+  DROP(1);
+}
+
+void f_deactivate() {
+  PUSHP(ACTIVE_FILE);
+  ACTIVE_FILE = NULL;
+}
+
+void f_activate() {
+  f_close();
+  ACTIVE_FILE = TOP().fp;
+  DROP(1);
+}
+
+void f_seek() {
+  fseek(ACTIVE_FILE, TOP().u, SEEK_SET);
+  DROP(1);
+}
+
+void f_seekend() {
+  fseek(ACTIVE_FILE, 0, SEEK_END);
+}
+
+void f_tell() {
+  PUSHU(ftell(ACTIVE_FILE));
+}
+
 void f_swapinput() {
   cell *key = RUNNING + TASK_USER_KEY;
   cell *keysrc = RUNNING + TASK_USER_KEYSRC;
@@ -810,7 +892,7 @@ void f_init() {
   CDEF("over", f_over);
   CDEF("drop", f_drop);
   CDEF("swap", f_swap);
-  CDEF("rot", f_rot);
+  CDEF("<rot", f_rot);
   CDEF("r>", f_rput);
   CDEF("r<", f_rtake);
   CDEF("r@", f_rtop);
@@ -835,7 +917,18 @@ void f_init() {
   CDEF(",", f_comma);
   CDEF("b,", f_bcomma);
   CDEF("open", f_open);
+  CDEF("overwrite", f_overwrite);
   CDEF("close", f_close);
+  CDEF("factivate", f_activate);
+  CDEF("fdeactivate", f_deactivate);
+  CDEF("seek", f_seek);
+  CDEF("seekend", f_seekend);
+  CDEF("fputc", f_fputc);
+  CDEF("fput", f_fput);
+  CDEF("fgetc", f_fgetc);
+  CDEF("fget", f_fget);
+  CDEF("fwrite", f_fwrite);
+  CDEF("fread", f_fread);
   CDEF("quiet", f_quiet);
   CDEF("loud", f_loud);
   CDEF("task", f_task);
@@ -848,6 +941,7 @@ void f_init() {
 
   PUSHS("boot.jor");
   f_open();
+  f_deactivate();
   PUSHS("key-file");
   f_lookup();
   DROP(1);

testbed.c

@@ -158,6 +158,11 @@ void f_mapsize() { // ( -- w h )
   PUSHI(screen.h);
 }
 
+void f_mapsize_set() { // ( w h -- )
+  loadMap(map, ST1().i, TOP().i);
+  DROP(2);
+}
+
 void f_mousepos() { // ( -- x y )
   PUSHI(MOUSE.x);
   PUSHI(MOUSE.y);
@@ -180,6 +185,7 @@ void game_f_init() {
   CDEF("text", f_text);
   CDEF("map", f_map);
   CDEF("mapsize", f_mapsize);
+  CDEF("mapsize!", f_mapsize_set);
   CDEF("mousepos", f_mousepos);
   CDEF("mousebuttons", f_mousebuttons);