\ lzw code

variable current-code

defer next-code ( -- code )
: (next-code) current-code @ 1+ dup current-code !  
; latestxt is next-code

\ dictionary stuff

0 value lzw-wordlist

defer dictionary-add
: (dictionary-add) ( addr len code -- )
    get-current >r >r
    lzw-wordlist set-current
    nextname create
    r> , r> set-current
; latestxt is dictionary-add

defer dictionary-contains
: (dictionary-contains) ( addr len -- contains? )
    dup 1 = if
	2drop -1
    else
	lzw-wordlist search-wordlist dup if nip endif
    endif
; latestxt is dictionary-contains


defer dictionary-get
: (dictionary-get) ( addr len -- code )
    dup 1 = if
	drop c@
    else
	lzw-wordlist search-wordlist drop execute @
    endif
; latestxt is dictionary-get

defer dictionary-init
: (dictionary-init)
    255 current-code !
    table to lzw-wordlist
; latestxt is dictionary-init

defer dictionary-destroy
: (dictionary-destroy) ;
latestxt is dictionary-destroy

\ the compression algorithm

defer current-char
: (current-char) ( len addr wlen -- len addr nwlen len<=nwlen )
    1+ >r over r> swap over >=
; latestxt is current-char

defer dismiss-old-chars
: (dismiss-old-chars) ( len addr wlen -- nlen naddr 1 )
    dup chars rot + >r - r> 1
; latestxt is dismiss-old-chars

variable stats

defer code-out
: (code-out) ( code -- )
    stats @ 1+ stats !
    dup 256 < if emit else [char] < emit space . [char] > emit endif space
; latestxt is code-out

: lzw-compress ( addr len -- [outputs code] )
    dictionary-init
    0 stats !

    swap 0 ( len addr 0 )
    begin
	current-char while
	    2dup dictionary-contains 0= if
		( add code for w+c )
		2dup next-code dictionary-add
		( output code for w )
		1- 2dup dictionary-get code-out
		( set w to c )
		dismiss-old-chars
	    endif
    repeat
    
    ( output code for w )
    1- dictionary-get code-out
    drop

    dictionary-destroy
;

: lzw-stats ( addr len -- bits lzw-bits )
    dup >r lzw-compress r> 8 * stats @ 12 *
;

: lzw-compress-file ( addr len -- [outputs code] )
    slurp-file lzw-compress
;