1 ! Copyright (C) 2009 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays combinators grouping kernel locals math
4 math.matrices math.order multiline sequences.parser sequences
6 IN: compression.run-length
8 : run-length-uncompress ( byte-array -- byte-array' )
9 2 group [ first2 <array> ] map B{ } concat-as ;
11 : 8hi-lo ( byte -- hi lo )
12 [ 0xf0 bitand -4 shift ] [ 0xf bitand ] bi ; inline
14 :: run-length-uncompress-bitmap4 ( byte-array m n -- byte-array' )
15 byte-array <sequence-parser> :> sp
16 m 1 + n zero-matrix :> matrix
22 ! i j [ number>string ] bi@ " " glue .
24 sp next dup 0x03 0xff between? [
25 nip [ sp ] dip dup odd?
26 [ 1 + take-n but-last ] [ take-n ] if
27 [ j matrix i swap nth copy ] [ length j + j! ] bi
30 { 0 [ i 1 + i! 0 j! ] }
32 { 2 [ sp next j + j! sp next i + i! ] }
36 [ sp next 8hi-lo 2array <repetition> concat ] [ head ] bi
37 [ j matrix i swap nth copy ] [ length j + j! ] bi
40 ! j stride >= [ i 1 + i! 0 j! ] when
41 j stride >= [ 0 j! ] when
44 matrix B{ } concat-as ;
46 :: run-length-uncompress-bitmap8 ( byte-array m n -- byte-array' )
47 byte-array <sequence-parser> :> sp
48 m 1 + n zero-matrix :> matrix
54 ! i j [ number>string ] bi@ " " glue .
56 sp next dup 0x03 0xff between? [
57 nip [ sp ] dip dup odd?
58 [ 1 + take-n but-last ] [ take-n ] if
59 [ j matrix i swap nth copy ] [ length j + j! ] bi
62 { 0 [ i 1 + i! 0 j! ] }
64 { 2 [ sp next j + j! sp next i + i! ] }
68 sp next <array> [ j matrix i swap nth copy ] [ length j + j! ] bi
71 ! j stride >= [ i 1 + i! 0 j! ] when
72 j stride >= [ 0 j! ] when
75 matrix B{ } concat-as ;