basis/compression/run-length/run-length.factor

   1 ! Copyright (C) 2009 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays combinators grouping kernel math math.matrices
   4 math.order sequences sequences.parser ;
   5 IN: compression.run-length
   6
   7 : run-length-uncompress ( byte-array -- byte-array' )
   8     2 group [ first2 <array> ] map B{ } concat-as ;
   9
  10 : 8hi-lo ( byte -- hi lo )
  11     [ 0xf0 bitand -4 shift ] [ 0xf bitand ] bi ; inline
  12
  13 :: run-length-uncompress-bitmap4 ( byte-array m n -- byte-array' )
  14     byte-array <sequence-parser> :> sp
  15     m  1 + n <zero-matrix> :> matrix
  16     n 4 mod n + :> stride
  17     0 :> i!
  18     0 :> j!
  19     f :> done?!
  20     [
  21         ! i j [ number>string ] bi@ " " glue .
  22         sp next dup 0 = [
  23             sp next dup 0x03 0xff between? [
  24                 nip [ sp ] dip dup odd?
  25                 [ 1 + take-n but-last ] [ take-n ] if
  26                 [ j matrix i swap nth copy ] [ length j + j! ] bi
  27             ] [
  28                 nip {
  29                     { 0 [ i 1 + i!  0 j! ] }
  30                     { 1 [ t done?! ] }
  31                     { 2 [ sp next j + j!  sp next i + i! ] }
  32                 } case
  33             ] if
  34         ] [
  35             [ sp next 8hi-lo 2array <repetition> concat ] [ head ] bi
  36             [ j matrix i swap nth copy ] [ length j + j! ] bi
  37         ] if
  38
  39         ! j stride >= [ i 1 + i!  0 j! ] when
  40         j stride >= [ 0 j! ] when
  41         done? not
  42     ] loop
  43     matrix B{ } concat-as ;
  44
  45 :: run-length-uncompress-bitmap8 ( byte-array m n -- byte-array' )
  46     byte-array <sequence-parser> :> sp
  47     m  1 + n <zero-matrix> :> matrix
  48     n 4 mod n + :> stride
  49     0 :> i!
  50     0 :> j!
  51     f :> done?!
  52     [
  53         ! i j [ number>string ] bi@ " " glue .
  54         sp next dup 0 = [
  55             sp next dup 0x03 0xff between? [
  56                 nip [ sp ] dip dup odd?
  57                 [ 1 + take-n but-last ] [ take-n ] if
  58                 [ j matrix i swap nth copy ] [ length j + j! ] bi
  59             ] [
  60                 nip {
  61                     { 0 [ i 1 + i!  0 j! ] }
  62                     { 1 [ t done?! ] }
  63                     { 2 [ sp next j + j!  sp next i + i! ] }
  64                 } case
  65             ] if
  66         ] [
  67             sp next <array> [ j matrix i swap nth copy ] [ length j + j! ] bi
  68         ] if
  69
  70         ! j stride >= [ i 1 + i!  0 j! ] when
  71         j stride >= [ 0 j! ] when
  72         done? not
  73     ] loop
  74     matrix B{ } concat-as ;