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

images.loader and friends: push throws-on-eof down to the loaders that want it

db4
Joe Groff 2010-07-09 14:20:32 -07:00
parent 99db070c9e
commit 9a2dd6a96c
5 changed files with 41 additions and 48 deletions

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

@ -4,7 +4,7 @@ USING: accessors alien.c-types arrays byte-arrays combinators
compression.run-length fry grouping images images.loader
images.normalization io io.binary io.encodings.8-bit.latin1
io.encodings.string kernel math math.bitwise sequences
specialized-arrays summary ;
specialized-arrays summary io.streams.throwing ;
QUALIFIED-WITH: bitstreams b
SPECIALIZED-ARRAYS: uint ushort ;
IN: images.bitmap
@ -348,20 +348,22 @@ ERROR: unsupported-bitmap-file magic ;
: load-bitmap ( stream -- loading-bitmap )
[
\ loading-bitmap new
parse-file-header [ >>file-header ] [ ] bi magic>> {
{ "BM" [
dup file-header>> header-length>> parse-header >>header
parse-color-palette
parse-color-data
] }
! { "BA" [ parse-os2-bitmap-array ] }
! { "CI" [ parse-os2-color-icon ] }
! { "CP" [ parse-os2-color-pointer ] }
! { "IC" [ parse-os2-icon ] }
! { "PT" [ parse-os2-pointer ] }
[ unsupported-bitmap-file ]
} case
[
\ loading-bitmap new
parse-file-header [ >>file-header ] [ ] bi magic>> {
{ "BM" [
dup file-header>> header-length>> parse-header >>header
parse-color-palette
parse-color-data
] }
! { "BA" [ parse-os2-bitmap-array ] }
! { "CI" [ parse-os2-color-icon ] }
! { "CP" [ parse-os2-color-pointer ] }
! { "IC" [ parse-os2-icon ] }
! { "PT" [ parse-os2-pointer ] }
[ unsupported-bitmap-file ]
} case
] input-throws-on-eof
] with-input-stream ;
: loading-bitmap>bytes ( loading-bitmap -- byte-array )

9
basis/images/loader/loader.factor
View File

@ -34,13 +34,10 @@ GENERIC: stream>image ( stream class -- image )
: load-image ( path -- image )
[ open-image-file ] [ image-class ] bi load-image* ;
M: byte-array load-image*
[
[ binary <byte-reader> ] [ length ] bi
<limited-stream> dup
] dip '[ _ stream>image ] throws-on-eof ;
M: object load-image* stream>image ;
M: limited-stream load-image* stream>image ;
M: byte-array load-image*
[ binary <byte-reader> ] dip stream>image ;
M: string load-image* [ open-image-file ] dip stream>image ;

12
basis/images/png/png.factor
View File

@ -4,7 +4,7 @@ USING: accessors arrays checksums checksums.crc32 combinators
compression.inflate fry grouping images images.loader io
io.binary io.encodings.ascii io.encodings.string kernel locals
math math.bitwise math.ranges sequences sorting assocs
math.functions math.order byte-arrays ;
math.functions math.order byte-arrays io.streams.throwing ;
QUALIFIED-WITH: bitstreams bs
IN: images.png
@ -319,10 +319,12 @@ ERROR: invalid-color-type/bit-depth loading-png ;
: load-png ( stream -- loading-png )
[
<loading-png>
read-png-header
read-png-chunks
parse-ihdr-chunk
[
<loading-png>
read-png-header
read-png-chunks
parse-ihdr-chunk
] input-throws-on-eof
] with-input-stream ;
M: png-image stream>image

4
basis/images/tga/tga.factor
View File

@ -3,7 +3,7 @@
USING: accessors images images.loader io io.binary kernel
locals math sequences io.encodings.ascii io.encodings.string
calendar math.ranges math.parser colors arrays hashtables
ui.pixel-formats combinators continuations ;
ui.pixel-formats combinators continuations io.streams.throwing ;
IN: images.tga
SINGLETON: tga-image
@ -254,7 +254,7 @@ ERROR: bad-tga-unsupported ;
ubyte-components >>component-type ;
M: tga-image stream>image
drop [ read-tga ] with-input-stream ;
drop [ [ read-tga ] input-throws-on-eof ] with-input-stream ;
M: tga-image image>stream
drop

32
basis/images/tiff/tiff.factor
View File

@ -6,7 +6,7 @@ io.binary io.encodings.ascii io.encodings.binary
io.encodings.string io.encodings.utf8 io.files kernel math
math.bitwise math.order math.parser pack sequences
strings math.vectors specialized-arrays locals
images.loader ;
images.loader io.streams.throwing ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
IN: images.tiff
@ -519,14 +519,12 @@ ERROR: unknown-component-order ifd ;
: with-tiff-endianness ( loading-tiff quot -- )
[ dup endianness>> ] dip with-endianness ; inline
: load-tiff-ifds ( stream -- loading-tiff )
[
<loading-tiff>
read-header [
dup ifd-offset>> read-ifds
process-ifds
] with-tiff-endianness
] with-input-stream* ;
: load-tiff-ifds ( -- loading-tiff )
<loading-tiff>
read-header [
dup ifd-offset>> read-ifds
process-ifds
] with-tiff-endianness ;
: process-chunky-ifd ( ifd -- )
read-strips
@ -556,19 +554,13 @@ ERROR: unknown-component-order ifd ;
: process-tif-ifds ( loading-tiff -- )
ifds>> [ process-ifd ] each ;
: load-tiff ( stream -- loading-tiff )
[ load-tiff-ifds dup ]
[
[ [ 0 seek-absolute ] dip stream-seek ]
[
[
[ process-tif-ifds ] with-tiff-endianness
] with-input-stream
] bi
] bi ;
: load-tiff ( -- loading-tiff )
load-tiff-ifds dup
0 seek-absolute seek-input
[ process-tif-ifds ] with-tiff-endianness ;
! tiff files can store several images -- we just take the first for now
M: tiff-image stream>image ( stream tiff-image -- image )
drop load-tiff tiff>image ;
drop [ [ load-tiff tiff>image ] input-throws-on-eof ] with-input-stream ;
{ "tif" "tiff" } [ tiff-image register-image-class ] each