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

report unhandled compression modes

db4
Doug Coleman 2009-06-02 23:20:07 -05:00
parent 43bcfd2944
commit 367623e375
1 changed files with 25 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -21,7 +21,8 @@ TUPLE: bitmap-image < image ;
TUPLE: loading-bitmap TUPLE: loading-bitmap
size reserved offset header-length width size reserved offset header-length width
height planes bit-count compression size-image height planes bit-count compression size-image
x-pels y-pels color-used color-important rgb-quads color-index ; x-pels y-pels color-used color-important color-palette color-index
uncompressed-bytes ;
ERROR: bitmap-magic magic ; ERROR: bitmap-magic magic ;
@ -31,7 +32,7 @@ M: bitmap-magic summary
<PRIVATE <PRIVATE
: 8bit>buffer ( bitmap -- array ) : 8bit>buffer ( bitmap -- array )
[ rgb-quads>> 4 <sliced-groups> [ 3 head-slice ] map ] [ color-palette>> 4 <sliced-groups> [ 3 head-slice ] map ]
[ color-index>> >array ] bi [ swap nth ] with map concat ; [ color-index>> >array ] bi [ swap nth ] with map concat ;
ERROR: bmp-not-supported n ; ERROR: bmp-not-supported n ;
@ -39,7 +40,7 @@ ERROR: bmp-not-supported n ;
: reverse-lines ( byte-array width -- byte-array ) : reverse-lines ( byte-array width -- byte-array )
<sliced-groups> <reversed> concat ; inline <sliced-groups> <reversed> concat ; inline
: raw-bitmap>seq ( loading-bitmap -- array ) : bitmap>bytes ( loading-bitmap -- array )
dup bit-count>> dup bit-count>>
{ {
{ 32 [ color-index>> ] } { 32 [ color-index>> ] }
@ -48,6 +49,21 @@ ERROR: bmp-not-supported n ;
[ bmp-not-supported ] [ bmp-not-supported ]
} case >byte-array ; } case >byte-array ;
ERROR: unsupported-bitmap-compression compression ;
: uncompress-bitmap ( loading-bitmap -- loading-bitmap' )
dup compression>> {
{ 0 [ ] }
{ 1 [ "run-length encoding 8" unsupported-bitmap-compression ] }
{ 2 [ "run-length encoding 4" unsupported-bitmap-compression ] }
{ 3 [ "bitfields" unsupported-bitmap-compression ] }
{ 4 [ "jpeg" unsupported-bitmap-compression ] }
{ 5 [ "png" unsupported-bitmap-compression ] }
} case ;
: loading-bitmap>bytes ( loading-bitmap -- byte-array )
uncompress-bitmap bitmap>bytes ;
: parse-file-header ( loading-bitmap -- loading-bitmap ) : parse-file-header ( loading-bitmap -- loading-bitmap )
2 read "BM" assert-sequence= 2 read "BM" assert-sequence=
read4 >>size read4 >>size
@ -67,7 +83,7 @@ ERROR: bmp-not-supported n ;
read4 >>color-used read4 >>color-used
read4 >>color-important ; read4 >>color-important ;
: rgb-quads-length ( loading-bitmap -- n ) : color-palette-length ( loading-bitmap -- n )
[ offset>> 14 - ] [ header-length>> ] bi - ; [ offset>> 14 - ] [ header-length>> ] bi - ;
: color-index-length ( loading-bitmap -- n ) : color-index-length ( loading-bitmap -- n )
@ -98,11 +114,11 @@ ERROR: bmp-not-supported n ;
] when ; ] when ;
: parse-bitmap ( loading-bitmap -- loading-bitmap ) : parse-bitmap ( loading-bitmap -- loading-bitmap )
dup rgb-quads-length read >>rgb-quads dup color-palette-length read >>color-palette
dup color-index-length read >>color-index dup color-index-length read >>color-index
fixup-color-index ; fixup-color-index ;
: load-bitmap-data ( path -- loading-bitmap ) : load-bitmap ( path -- loading-bitmap )
binary [ binary [
loading-bitmap new loading-bitmap new
parse-file-header parse-bitmap-header parse-bitmap parse-file-header parse-bitmap-header parse-bitmap
@ -120,14 +136,14 @@ ERROR: unknown-component-order bitmap ;
: loading-bitmap>bitmap-image ( bitmap-image loading-bitmap -- bitmap-image ) : loading-bitmap>bitmap-image ( bitmap-image loading-bitmap -- bitmap-image )
{ {
[ raw-bitmap>seq >>bitmap ] [ loading-bitmap>bytes >>bitmap ]
[ [ width>> ] [ height>> abs ] bi 2array >>dim ] [ [ width>> ] [ height>> abs ] bi 2array >>dim ]
[ height>> 0 < [ t >>upside-down? ] when ] [ height>> 0 < [ t >>upside-down? ] when ]
[ bitmap>component-order >>component-order ] [ bitmap>component-order >>component-order ]
} cleave ; } cleave ;
M: bitmap-image load-image* ( path loading-bitmap -- bitmap ) M: bitmap-image load-image* ( path loading-bitmap -- bitmap )
swap load-bitmap-data loading-bitmap>bitmap-image ; swap load-bitmap loading-bitmap>bitmap-image ;
"bmp" bitmap-image register-image-class "bmp" bitmap-image register-image-class
@ -185,7 +201,7 @@ PRIVATE>
! color-important ! color-important
[ drop 0 write4 ] [ drop 0 write4 ]
! rgb-quads ! color-palette
[ [
[ bitmap>color-index ] [ bitmap>color-index ]
[ dim>> first 3 * ] [ dim>> first 3 * ]