Pete's house map, map resizing words

defs.jor

@@ -19,11 +19,17 @@ s" jorth.log" open seekend deactivate const LOGFILE
 : defer word new-word docolon , ' noop , ' ret , ;
 : redefine ( cp cpdeferred ) cell + ! ;
 
-: for ( from to -- ) here ' r> , ' r> , ; immediate ( r: to from )
+: +towards ( from to -- from+-1 )
+  over > if 1 + else 1 - then ;
+
+: for ( from to -- ) ' r> , here ' r> , ; immediate ( r: to from )
 : i ' r@ , ; immediate
-: next ' r< , 1 lit ' + , ' r< , ( from+1 to )
+: next ' r< , ' r@ , ' +towards , ( from+1 r: to )
-       ' 2dup , ' - , ' BNZ_ , ,
+       ' dup , ' r@ , ' = , ' BZ_ , ,
-       ' drop , ' drop , ; immediate
+       ' rdrop , ' drop , ; immediate
+
+: min ( x y -- x|y ) 2dup > if swap then drop ;
+: max ( x y -- x|y ) 2dup < if swap then drop ;
 
 : decompile
   word lookup if 1 begin ( cp i )

game.jor

@@ -126,7 +126,7 @@ var prevbutton
   <rot + >rot + swap ;
 
 var tileselect
-3 const MAXTILE
+8 const MAXTILE
 
 : mouseworldpos mousepos scrollpos +pos ;
 : mousetile mouseworldpos 4 >> swap 4 >> swap ;
@@ -142,6 +142,19 @@ var tileselect
 
   MOUSEL mousedown if tileselect @ mousetile tile b! then ;
 
+: copy-mapseg ( neww oldw y -- )
+  r> ( oldw neww r: y )
+  2dup min >rot ( copyw neww oldw )
+  r@ * map + ( copyw neww src )
+  swap r< * map + ( copyw src dst )
+  swap <rot memmove ;
+
+: resize-map ( neww newh -- )
+  swap mapsize r> ( newh neww oldw r: oldh )
+  2dup < if 1 r< else r< 1 - 0 then ( newh neww copyw ystart ylim )
+  for 2dup i copy-mapseg next
+  drop swap mapsize! ;
+
 : save-map ( filename -- )
   fdeactivate swap overwrite
   mapsize swap fput fput
@@ -149,8 +162,8 @@ var tileselect
   factivate ;
 
 : load-map ( filename -- )
-  fdeactivate swap open
+  fdeactivate swap open tell .
-  fget fget
+  fget tell . fget tell . cr .s
   2dup * map fread
   mapsize!
   factivate ;
@@ -220,3 +233,5 @@ JOB listen-for-jobs
 
 MODE-MOVE @ ' tick redefine
 ' full-draw ' draw redefine
+
+s" pete.map" load-map

jorth.c

@@ -291,15 +291,14 @@ void f_putc() {
 
 void f_fputc() {
   if (ACTIVE_FILE) {
-    fputc(TOP().i, ACTIVE_FILE);
+    fwrite(&TOP().i, 1, 1, ACTIVE_FILE);
   }
   DROP(1);
 }
 
 void f_fput() {
   if (ACTIVE_FILE) {
-    fputc(TOP().u & 0xff, ACTIVE_FILE);
+    fwrite(&TOP().u, 2, 1, ACTIVE_FILE);
-    fputc((TOP().u >> 8) & 0xff, ACTIVE_FILE);
   }
   DROP(1);
 }
@@ -312,18 +311,21 @@ void f_fwrite() { // ( length p )
 }
 
 void f_fgetc() {
+  int result = EOF;
   if (ACTIVE_FILE) {
-    PUSHI(fgetc(ACTIVE_FILE));
+    char byte = 0;
-  } else {
+    if (fread(&byte, 1, 1, ACTIVE_FILE) == 1) {
-    PUSHI(EOF);
+      result = byte;
     }
+  }
+  PUSHI(result);
 }
 
 void f_fget() {
   if (ACTIVE_FILE) {
-    int low = fgetc(ACTIVE_FILE);
+    int result = 0;
-    int high = fgetc(ACTIVE_FILE);
+    int err = fread(&result, 2, 1, ACTIVE_FILE);
-    PUSHU(low | (high << 8));
+    PUSHU(result);
   } else {
     PUSHU(0); // no way to signal EOF
   }
@@ -637,7 +639,7 @@ void f_close() {
 void f_open() {
   FILE *fp;
   f_close();
-  fp = fopen(TOP().s, "a+");
+  fp = fopen(TOP().s, "ab+");
   fseek(fp, 0, SEEK_SET);
   ACTIVE_FILE = fp;
   DROP(1);
@@ -645,7 +647,7 @@ void f_open() {
 
 void f_overwrite() {
   f_close();
-  ACTIVE_FILE = fopen(TOP().s, "w+");
+  ACTIVE_FILE = fopen(TOP().s, "wb+");
   DROP(1);
 }
 
@@ -744,6 +746,10 @@ void f_inline_data_() {
   IP = *IP.p;
 }
 
+void f_memmove() { // ( dst src size -- )
+  memmove(ST2().p, ST1().p, TOP().u);
+  DROP(3);
+}
 void f_quote() {
   if (STATE.i) {
     PUSHS("LIT_");
@@ -923,12 +929,14 @@ void f_init() {
   CDEF("fdeactivate", f_deactivate);
   CDEF("seek", f_seek);
   CDEF("seekend", f_seekend);
+  CDEF("tell", f_tell);
   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("memmove", f_memmove);
   CDEF("quiet", f_quiet);
   CDEF("loud", f_loud);
   CDEF("task", f_task);