steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

working on rle uncompresion for bitmaps

db4
Doug Coleman 2009-06-10 15:16:17 -04:00
parent 6434e4acf1
commit 0262074b97
2 changed files with 71 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
basis/compression/run-length/run-length.factor
View File

@ -5,7 +5,71 @@ math.matrices math.order multiline sequence-parser sequences
tools.continuations ; tools.continuations ;
IN: compression.run-length IN: compression.run-length
: run-length-uncompress ( byte-array -- byte-array' ) : run-length-uncompress ( byte-array -- byte-array' )
2 group [ first2 <array> ] map B{ } concat-as ; 2 group [ first2 <array> ] map B{ } concat-as ;
: 8hi-lo ( byte -- hi lo )
[ HEX: f0 bitand -4 shift ] [ HEX: f bitand ] bi ; inline
:: run-length-uncompress-bitmap4 ( byte-array m n -- byte-array' )
byte-array <sequence-parser> :> sp
m 1 + n zero-matrix :> matrix
n 4 mod n + :> stride
0 :> i!
0 :> j!
f :> done?!
[
! i j [ number>string ] bi@ " " glue .
sp next dup 0 = [
sp next dup HEX: 03 HEX: ff between? [
nip [ sp ] dip dup odd?
[ 1 + take-n but-last ] [ take-n ] if
[ j matrix i swap nth copy ] [ length j + j! ] bi
] [
nip {
{ 0 [ i 1 + i! 0 j! ] }
{ 1 [ t done?! ] }
{ 2 [ sp next j + j! sp next i + i! ] }
} case
] if
] [
[ sp next 8hi-lo 2array <repetition> concat ] [ head ] bi
[ j matrix i swap nth copy ] [ length j + j! ] bi
] if
! j stride >= [ i 1 + i! 0 j! ] when
j stride >= [ 0 j! ] when
done? not
] loop
matrix B{ } concat-as ;
:: run-length-uncompress-bitmap8 ( byte-array m n -- byte-array' )
byte-array <sequence-parser> :> sp
m 1 + n zero-matrix :> matrix
n 4 mod n + :> stride
0 :> i!
0 :> j!
f :> done?!
[
! i j [ number>string ] bi@ " " glue .
sp next dup 0 = [
sp next dup HEX: 03 HEX: ff between? [
nip [ sp ] dip dup odd?
[ 1 + take-n but-last ] [ take-n ] if
[ j matrix i swap nth copy ] [ length j + j! ] bi
] [
nip {
{ 0 [ i 1 + i! 0 j! ] }
{ 1 [ t done?! ] }
{ 2 [ sp next j + j! sp next i + i! ] }
} case
] if
] [
sp next <array> [ j matrix i swap nth copy ] [ length j + j! ] bi
] if
! j stride >= [ i 1 + i! 0 j! ] when
j stride >= [ 0 j! ] when
done? not
] loop
matrix B{ } concat-as ;

14
basis/images/bitmap/bitmap.factor
View File

@ -102,20 +102,18 @@ GENERIC: uncompress-bitmap* ( loading-bitmap header -- loading-bitmap )
M: os2-header uncompress-bitmap* ( loading-bitmap header -- loading-bitmap' ) M: os2-header uncompress-bitmap* ( loading-bitmap header -- loading-bitmap' )
drop ; drop ;
: do-run-length-uncompress ( loading-bitmap -- loading-bitmap ) : do-run-length-uncompress ( loading-bitmap word -- loading-bitmap )
dup '[ dupd '[
_ header>> [ width>> ] [ height>> ] bi _ header>> [ width>> ] [ height>> ] bi
run-length-uncompress-bitmap _ execute
] change-color-index ; ] change-color-index ; inline
M: v-header uncompress-bitmap* ( loading-bitmap header -- loading-bitmap' ) M: v-header uncompress-bitmap* ( loading-bitmap header -- loading-bitmap' )
compression>> { compression>> {
{ f [ ] } { f [ ] }
{ 0 [ ] } { 0 [ ] }
{ 1 [ [ run-length-uncompress ] change-color-index ] } { 1 [ \ run-length-uncompress-bitmap8 do-run-length-uncompress ] }
{ 2 [ [ 4 b:byte-array-n>seq run-length-uncompress ] change-color-index ] } { 2 [ \ run-length-uncompress-bitmap4 do-run-length-uncompress ] }
! { 1 [ do-run-length-uncompress ] }
! { 2 [ [ 4 b:byte-array-n>seq ] change-color-index do-run-length-uncompress ] }
{ 3 [ uncompress-bitfield-widths ] } { 3 [ uncompress-bitfield-widths ] }
{ 4 [ "jpeg" unsupported-bitmap-compression ] } { 4 [ "jpeg" unsupported-bitmap-compression ] }
{ 5 [ "png" unsupported-bitmap-compression ] } { 5 [ "png" unsupported-bitmap-compression ] }