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

   1 ! Copyright (C) 2009 Doug Coleman.
   2 ! See https://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 consume dup 0 = [
  23             sp consume 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 consume j + j!
  32                           sp consume i + i! ] }
  33                 } case
  34             ] if
  35         ] [
  36             [ sp consume 8hi-lo 2array <repetition> concat ] [ head ] bi
  37             [ j matrix i swap nth copy ] [ length j + j! ] bi
  38         ] if
  39
  40         ! j stride >= [ i 1 + i!  0 j! ] when
  41         j stride >= [ 0 j! ] when
  42         done? not
  43     ] loop
  44     matrix B{ } concat-as ;
  45
  46 :: run-length-uncompress-bitmap8 ( byte-array m n -- byte-array' )
  47     byte-array <sequence-parser> :> sp
  48     m  1 + n <zero-matrix> :> matrix
  49     n 4 mod n + :> stride
  50     0 :> i!
  51     0 :> j!
  52     f :> done?!
  53     [
  54         ! i j [ number>string ] bi@ " " glue .
  55         sp consume dup 0 = [
  56             sp consume 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
  60             ] [
  61                 nip {
  62                     { 0 [ i 1 + i!  0 j! ] }
  63                     { 1 [ t done?! ] }
  64                     { 2 [ sp consume j + j!
  65                           sp consume i + i! ] }
  66                 } case
  67             ] if
  68         ] [
  69             sp consume <array> [ j matrix i swap nth copy ] [ length j + j! ] bi
  70         ] if
  71
  72         ! j stride >= [ i 1 + i!  0 j! ] when
  73         j stride >= [ 0 j! ] when
  74         done? not
  75     ] loop
  76     matrix B{ } concat-as ;