54 lines
1.9 KiB
Plaintext
Executable file
54 lines
1.9 KiB
Plaintext
Executable file
: 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 ( call with iterator that returns bytes )
|
|
>rle-start each i iterate if i 8 << | >rle else drop then next >rle-done ;
|
|
: embed-rle ( host-filename -- ) open filebytes encode-rle ;
|
|
: embed-file ( fp -- )
|
|
>r target 0 w>t 0xffff target r@ T] fread <r close
|
|
T] fcount @t target + target! target swap !t ;
|
|
: embed ( host-filename -- ) open embed-file ;
|
|
}
|
|
|
|
: embed-data ( embed -- p ) cell + ;
|
|
: embed-size ( embed -- v ) dup @ swap embed-data - ;
|
|
|
|
: 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 )) ;
|