working on rle uncompresion for bitmaps
parent
6434e4acf1
commit
0262074b97
|
@ -5,7 +5,71 @@ math.matrices math.order multiline sequence-parser sequences
|
|||
tools.continuations ;
|
||||
IN: compression.run-length
|
||||
|
||||
|
||||
: run-length-uncompress ( byte-array -- byte-array' )
|
||||
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 ;
|
||||
|
|
|
@ -102,20 +102,18 @@ GENERIC: uncompress-bitmap* ( loading-bitmap header -- loading-bitmap )
|
|||
M: os2-header uncompress-bitmap* ( loading-bitmap header -- loading-bitmap' )
|
||||
drop ;
|
||||
|
||||
: do-run-length-uncompress ( loading-bitmap -- loading-bitmap )
|
||||
dup '[
|
||||
: do-run-length-uncompress ( loading-bitmap word -- loading-bitmap )
|
||||
dupd '[
|
||||
_ header>> [ width>> ] [ height>> ] bi
|
||||
run-length-uncompress-bitmap
|
||||
] change-color-index ;
|
||||
_ execute
|
||||
] change-color-index ; inline
|
||||
|
||||
M: v-header uncompress-bitmap* ( loading-bitmap header -- loading-bitmap' )
|
||||
compression>> {
|
||||
{ f [ ] }
|
||||
{ 0 [ ] }
|
||||
{ 1 [ [ run-length-uncompress ] change-color-index ] }
|
||||
{ 2 [ [ 4 b:byte-array-n>seq run-length-uncompress ] change-color-index ] }
|
||||
! { 1 [ do-run-length-uncompress ] }
|
||||
! { 2 [ [ 4 b:byte-array-n>seq ] change-color-index do-run-length-uncompress ] }
|
||||
{ 1 [ \ run-length-uncompress-bitmap8 do-run-length-uncompress ] }
|
||||
{ 2 [ \ run-length-uncompress-bitmap4 do-run-length-uncompress ] }
|
||||
{ 3 [ uncompress-bitfield-widths ] }
|
||||
{ 4 [ "jpeg" unsupported-bitmap-compression ] }
|
||||
{ 5 [ "png" unsupported-bitmap-compression ] }
|
||||
|
|
Loading…
Reference in New Issue