entry #1
written by Olek Sabak
submitted at
0 likes
guesses
- Olek Sabak (by essaie)
- Olek Sabak (by seshoumara)
- Olek Sabak (by oleander)
comments 0
lzw.factor ASCII text
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 | ! Copyright (C) 2025 Aleksander "olus2000" Sabak. ! See https://factorcode.org/license.txt for BSD license. USING: accessors assocs byte-arrays io io.encodings.binary io.streams.byte-array kernel math sequences ; IN: lzw ! Encoding <PRIVATE CONSTANT: dict-limit 0x10000 TUPLE: encoder-tree index next ; : <encoder-tree> ( index -- tree ) H{ } clone encoder-tree boa ; : <encoder-root> ( -- root ) f 256 <iota> dup [ <encoder-tree> ] map H{ } zip-as encoder-tree boa ; : next? ( tree byte -- tree? ) swap next>> at ; inline : write2 ( u16 -- ) 256 /mod write1 write1 ; : encode-step ( root size node byte -- root size node' ) 2dup next? [ 2nip ] [ [ [ 1 + ] [ <encoder-tree> ] bi ] 2dip [ swap [ index>> write2 ] [ next>> set-at ] bi ] keep overd next? ] if* ; PRIVATE> : write-lzw ( -- ) <encoder-root> 256 over [ read1 ] [ encode-step over dict-limit > [ [ 2drop <encoder-root> 256 over ] dip index>> next? ] when ] while* index>> [ write2 ] when* 2drop ; : >lzw ( bytes -- encoded ) binary [ binary [ write-lzw ] with-byte-writer ] with-byte-reader ; ! Decoding <PRIVATE : <decoder-dict> ( -- dict ) 256 <iota> [ 1byte-array ] map ; : read2 ( -- u16? ) read1 read1 2dup and [ 256 * + ] [ nip ] if ; : init-decoder ( -- dict prev? ) <decoder-dict> read2 dup [ over nth dup write ] when ; : decode-step ( dict prev new -- dict' prev' ) pick length over > [ pick nth ] [ drop dup dup first suffix ] if [ first suffix suffix ] keep dup write ; PRIVATE> : read-lzw ( -- ) init-decoder [ read2 ] [ decode-step over length dict-limit >= [ 2drop init-decoder ] when ] while* 2drop ; : lzw> ( encoded -- bytes ) binary [ binary [ read-lzw ] with-byte-writer ] with-byte-reader ; |
post a comment