RLE encoder, Rick's Clubhouse welcome screen

dialer.jrt

@@ -62,6 +62,15 @@ array dtmf-row 697 freq>div , 770 freq>div , 852 freq>div , 941 freq>div ,
 
 : connect ( st -- ) call noisy 200 sleep-csec handshake ;
 
+import embed.jrt
+array rick-welcome-rle { s" rickclub.bin" embed-rle }
+
+: xmit-screen ( rle -- ) 0 0 textxy! rle-decode each
+    i 8 >> textpen ! i emit
+  next ;
+
+: rick-welcome rick-welcome-rle xmit-screen ;
+
 { : X ( v -- v ) 2* 1 | ;
   : o ( v -- v ) 2* ; }
 7 const logoh
@@ -144,7 +153,7 @@ var curr-logobit
   lgray fg! ;
 
 : go splash 0 15 textxy! 
-  s" 5551212" connect s" CONNECT 57600" xmit nl ;
+  s" 5551212" connect s" CONNECT 57600" xmit nl rick-welcome ;
 
 ' go ' main redefine
 

embed.jrt

@@ -0,0 +1,51 @@
+: filebytes ( fp -- ) >arg 
+  (( begin dup fgetc dup EOF != while yield repeat drop close )) ;
+
+{
+( rle encoding is designed for textmode screens and assumes a file with an
+  even number of bytes )
+var rle-start
+var rle-run
+: >rle-start 0 rle-run !  target rle-start !  0 w>t ;
+: rle-ctrl ( -- b ) rle-run @ b@t 0xff & ;
+: rle-word ( -- v ) rle-run @ 1+ @t ;
+: repeating? ( -- f ) rle-ctrl 0x80 & not ;
+: inc-run ( -- f ) 
+  rle-ctrl dup 0x7f & 0x7f < if 1+ rle-run @ b!t 1 else drop 0 then ;
+: >rle ( v -- ) rle-run @ if
+    dup rle-word = if ( is match )
+      repeating? if ( is repeating run )
+        inc-run if drop return then
+      else ( undo last value of non-repeating run )
+        rle-ctrl 1- rle-run @ b!t
+        target cell - rle-run !
+        1 rle-run @ b!t
+        ( grow target by 1 byte ) 0 >t
+        rle-run @ 1+ !t ( write value at end of target )
+        return
+      then
+    else ( no match )
+      repeating? not if inc-run if w>t return then then
+    then
+  then ( if we have gotten here, start a new run )
+  target rle-run ! 0 >t w>t ;
+
+: >rle-done 0 rle-run ! target rle-start @ !t ;
+
+: encode-rle ( -- , with iterator that returns bytes )
+  >rle-start each i iteration if i 8 << | >rle else drop then next >rle-done ;
+: embed-rle ( host-filename -- ) open filebytes encode-rle ;
+: embed ( host-filename -- ) 
+  target 0 w>t open filebytes each i >t next target swap !t ;
+}
+
+: embed-size ( embed -- v ) dup @ swap - ;
+: embed-data ( embed -- p ) cell + ;
+
+: rle-decode ( p -- )
+  >arg (( dup @ swap cell + +arg ( pend p )
+    begin
+      1+ dup 1- ub@ dup 0x80 & swap 0x7f & 1+ times
+      if ( non-repeating ) each dup @ map cell + next
+      else   ( repeating ) each dup @ map next cell + then
+    2dup <= until drop drop )) ;

iter.jrt

@@ -98,7 +98,7 @@ nexttop :push >next
 { ( Because we dereference pointers on the return stack, we must run this 
     from the caller's segment. Copy the definition into the host segment. )
   : EACH_ <r iteration if cell + else @ then >r ;
-  : each ' EACH_ , >i 0 , ; immediate
+  : each ' EACH_ , here >i 0 , ; immediate
   : continue ' GOTO_ , i cell - , ; immediate
   : next ['] continue here <i ! ; immediate
   :timm each t, EACH_ patchpt >i ;

rickclub.bin

@@ -0,0 +1 @@
+   ÛÛÛÛÛÛ»  ÛÛ»  ÛÛÛÛÛÛ» ÛÛ»  ÛÛ» ÜÛ» ÛÛÛÛÛÛÛ»                                     ÛÛÉÍÍÛÛ» ÛÛº ÛÛÉÍÍÍͼ ÛÛº ÛÛɼ ßͼ ÛÛÉÍÍÍͼ       ÿ                             ÛÛÛÛÛÛɼ ÛÛº ÛÛº      ÛÛÛÛÛɼ      ÛÛÛÛÛÛÛ»        (273) 555-1212               ÛÛÉÍÍÛÛ» ÛÛº ÛÛº      ÛÛÉÍÛÛ»      ÈÍÍÍÍÛÛº                                     ÛÛº  ÛÛº ÛÛº ÈÛÛÛÛÛÛ» ÛÛº  ÛÛ»     ÛÛÛÛÛÛÛº                                     Èͼ  Èͼ Èͼ  ÈÍÍÍÍͼ Èͼ  Èͼ     ÈÍÍÍÍÍͼ                                     ÜÜÜÜÜÜÜ ÜÜÜ     ÜÜÜ ÜÜÜ ÜÜÜÜÜÜ  ÜÜÜ ÜÜÜ ÜÜÜÜÜÜÜ ÜÜÜ ÜÜÜ ÜÜÜÜÜÜÜ ÜÜÜÜÜÜÜ  	       ÛÿÜÜÜÜÛ ÛÿÛ     ÛÿÛ ÛÿÛ ÛÿÜÜÿÛÜ ÛÿÛÜÛÿÛ ÛÿÜÜÜÿÛ ÛÿÛ ÛÿÛ ÛÿÜÜÜÜÛ ÛÿÜÜÜÜÛ         ÛÿÛÜÜÜÜ ÛÿÛÜÜÜÜ ÛÿÛÜÛÿÛ ÛÿÜÜÜÿÛ ÛÿÜÜÜÿÛ ÛÿÛÜÛÿÛ ÛÿÛÜÛÿÛ ÛÜÜÜÜÿÛ ÛÿÜÜÜÛÜ         ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÛ ÛÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ                                                                                             SYSOP:ÿRick Toews                              ßÛßßÜ  ßÛßßÜ   ÜßßßÜ            ÚOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄO¿O               Û   Û  Û   Û Û                 ³O O OYOoOuOrO OfOrOiOeOnOdOlOyO OlOoOcOaOlO OcOoOmOpOuOtOeOrO O O³O              ßÛßßßÛ ßÛßßßÛ  ßßÜÜ             ³O O O O O O O O O O O OhOaOnOgOoOuOtO!O O O O O O O O O O O O O O³O               Û   Û  Û   Û      Û            ÀOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÙO              ß ßßß  ß ßßß  ßÜÜÜÜß