--- a/JPEGReader.st Wed Jun 01 07:00:31 2016 +0200
+++ b/JPEGReader.st Fri Jun 03 06:44:03 2016 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -17,7 +19,7 @@
instanceVariableNames:'jpeg_decompress_struct jpeg_compress_struct jpeg_error_mgr_struct
colorComponents forceGrayscale forceDitherMode app1SegmentHandler
compressQuality bytesPerRow'
- classVariableNames:'ErrorPrinting DefaultCompressQuality'
+ classVariableNames:'DefaultCompressQuality ErrorPrinting'
poolDictionaries:''
category:'Graphics-Images-Readers'
!
@@ -768,25 +770,40 @@
!JPEGReader methodsFor:'reading'!
fromStream:aStream
- "read a JPG image from a stream"
+ "read a JPG image from a stream.
+ For now, we can only read from a stdio-FILE with libjpeg
+ (need to write a mem-reader to read from a Smalltalk stream).
+ Therefore, any internal stream data is copied to a temporary file first,
+ and libjpg asked to decompress from there.
+ This should be fixed, if jpeg reading is a bottleneck in your app."
- |dataIdx bytesPerRow returnCode pos1 ok s|
+ |dataIdx bytesPerRow returnCode pos1 pos2 ok s img|
aStream isExternalStream ifFalse:[
- "/ libJpeg can only handle real OS-streams
+ "/ libJpeg can only handle real OS-streams
- s := FileStream newTemporary binary.
- [
- s nextPutAll:aStream contents.
- s reset.
- ^ self fromStream:s.
- ] ensure:[
- s close.
- s fileName delete.
- ].
-
- "/ 'JPEGReader [info]: can only read from real streams' infoPrintCR.
- "/ ^ nil
+ s := FileStream newTemporary binary.
+ [
+ pos1 := aStream position.
+ aStream copyToEndInto:s.
+ aStream position:pos1.
+ "/ s nextPutAll:aStream contents.
+ s reset.
+ img := self fromStream:s.
+ ] ensure:[
+ "/ leave the internal stream positioned correctly.
+ "/ sigh: jpgreader seems to read too much (buffer-filling?);
+ "/ so the position is usually beyond the actual end of the single image.
+ "/ for now, you have to use workarounds (such as scanning for SOI markers)
+ "/ to get individual images from a sequence.
+ pos2 := s position.
+ s close.
+ s fileName delete.
+ ].
+ img notNil ifTrue:[
+ aStream position:(pos1 + pos2).
+ ].
+ ^ img
].
inStream := aStream.
@@ -799,27 +816,27 @@
(self create_jpeg_decompress_struct not
or:[self start_decompress not]) ifTrue:[
- ok := false.
+ ok := false.
- "/ if there was no SOI marker,
- "/ try again, skipping first 128 bytes
- "/ (seems to be generated by some jpg writers)
+ "/ if there was no SOI marker,
+ "/ try again, skipping first 128 bytes
+ "/ (seems to be generated by some jpg writers)
- inStream position:pos1.
- ((inStream nextByte ~~ 16rFF)
- or:[inStream nextByte ~~ 16rD8]) ifTrue:[
- inStream position:pos1 + 128.
- ((inStream nextByte == 16rFF)
- and:[inStream nextByte == 16rD8]) ifTrue:[
- inStream position:pos1 + 128.
- ok := self create_jpeg_decompress_struct
- and:[self start_decompress]
- ].
- ].
- ok ifFalse:[
- 'JPEGReader [info]: ' infoPrint. self get_error_message infoPrintCR.
- ^ nil
- ]
+ inStream position:pos1.
+ ((inStream nextByte ~~ 16rFF)
+ or:[inStream nextByte ~~ 16rD8]) ifTrue:[
+ inStream position:pos1 + 128.
+ ((inStream nextByte == 16rFF)
+ and:[inStream nextByte == 16rD8]) ifTrue:[
+ inStream position:pos1 + 128.
+ ok := self create_jpeg_decompress_struct
+ and:[self start_decompress]
+ ].
+ ].
+ ok ifFalse:[
+ 'JPEGReader [info]: ' infoPrint. self get_error_message infoPrintCR.
+ ^ nil
+ ]
].
data := ByteArray uninitializedNew:(width * height * colorComponents).
@@ -827,27 +844,27 @@
bytesPerRow := colorComponents * width.
[(returnCode := self decompressChunkInto:data startingAt:dataIdx) > 0] whileTrue:[
- "/ got a row in the buffer ...
- dataIdx := dataIdx + bytesPerRow
+ "/ got a row in the buffer ...
+ dataIdx := dataIdx + bytesPerRow
].
returnCode < 0 ifTrue:[
- 'JPEGReader [info]: ' infoPrint. self get_error_message infoPrintCR.
- ^ nil
+ 'JPEGReader [info]: ' infoPrint. self get_error_message infoPrintCR.
+ ^ nil
].
(self finish_decompress) ifFalse:[
- 'JPEGReader [info]: ' infoPrint. self get_error_message infoPrintCR.
- ^ nil
+ 'JPEGReader [info]: ' infoPrint. self get_error_message infoPrintCR.
+ ^ nil
].
colorComponents == 3 ifTrue:[
- photometric := #rgb.
- samplesPerPixel := 3.
- bitsPerSample := #(8 8 8).
+ photometric := #rgb.
+ samplesPerPixel := 3.
+ bitsPerSample := #(8 8 8).
] ifFalse:[
- photometric := #blackIs0.
- samplesPerPixel := 1.
- bitsPerSample := #(8).
+ photometric := #blackIs0.
+ samplesPerPixel := 1.
+ bitsPerSample := #(8).
].
"
--- a/MIMETypes.st Wed Jun 01 07:00:31 2016 +0200
+++ b/MIMETypes.st Fri Jun 03 06:44:03 2016 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1997 by eXept Software AG
All Rights Reserved
@@ -15,14 +17,15 @@
Object subclass:#MIMETypes
instanceVariableNames:''
- classVariableNames:'TypeToImageReaderClassMapping TypeToCommentStringMapping
- TypeToFileSuffixMapping TypeToViewerApplicationMapping
- SuffixToCommentStringMapping FileSuffixToTypeMapping
- FilenameToTypeMapping FileSuffixToImageReaderClassMapping
- CharSetToFontMapping LastSuffix LastType
- DefaultCommandPerMIMEPerOS DefaultPrintCommandPerMIMEPerOS
- TypeToParenthesisSpecMapping SuffixToParenthesisSpecMapping
- TypeToInfoMapping'
+ classVariableNames:'CharSetToFontMapping DefaultCommandPerMIMEPerOS
+ DefaultPrintCommandPerMIMEPerOS
+ FileSuffixToImageReaderClassMapping FileSuffixToTypeMapping
+ FilenameToTypeMapping LastSuffix LastType
+ SuffixToCommentStringMapping SuffixToParenthesisSpecMapping
+ TypeFromContentsDetectors TypeToCommentStringMapping
+ TypeToFileSuffixMapping TypeToImageReaderClassMapping
+ TypeToInfoMapping TypeToParenthesisSpecMapping
+ TypeToViewerApplicationMapping'
poolDictionaries:''
category:'Net-Communication-Support'
!
@@ -104,6 +107,17 @@
!MIMETypes class methodsFor:'initialization'!
+addMimeTypeDetector:aMimeTypeFromContentsDetectorBlock
+ "any class (especially: image readers) may add a block
+ which detects the mime-type from a givel contents.
+ The block is called with two arguments, some data (usually the first few kilobytes
+ of a file) and the suffix of the file, or nil if unknown.
+ The block should return the mimeType or nil."
+
+ TypeFromContentsDetectors isNil ifTrue:[ TypeFromContentsDetectors := OrderedCollection new ].
+ TypeFromContentsDetectors add:aMimeTypeFromContentsDetectorBlock.
+!
+
initialize
"initialize wellKnown facts"
@@ -113,7 +127,7 @@
self initializeImageReaderMappings.
self initializeCommentStringMappings.
self initializeParenthesisSpecMappings.
-
+
"
self initialize
"
@@ -1011,16 +1025,27 @@
mimeTypeOfData:someData suffix:fileNameSuffixOrNilIfUnknown
"this tries to guess the mime type of contents of someData.
Returns nil, if unknown.
- This is done using some heuristics, and may need some improvement"
+ In addition to registered detectors (see addMimeTypeDetector:),
+ this is done using some heuristics, and may need some improvement"
|buffer lcBuffer size idx idx2|
someData isEmptyOrNil ifTrue:[^ nil].
+ TypeFromContentsDetectors notNil ifTrue:[
+ TypeFromContentsDetectors do:[:eachDetector |
+ |m|
+
+ m := eachDetector value:someData value:fileNameSuffixOrNilIfUnknown.
+ m notNil ifTrue:[^ m]
+ ]
+ ].
+
size := 2048 min:someData size.
"/ read some data from the file ...
buffer := (someData copyTo:size) asString.
+
lcBuffer := buffer asLowercase.
(idx := lcBuffer findString:'mimetype:') ~~ 0 ifTrue:[
@@ -1092,7 +1117,7 @@
^ MIMEType fromString:what
]
].
-
+
(idx := lcBuffer findString:'<h') ~~ 0 ifTrue:[
((lcBuffer continuesWith:'<head' startingAt:idx)
or:[(lcBuffer continuesWith:'<html' startingAt:idx)
--- a/TIFFReader.st Wed Jun 01 07:00:31 2016 +0200
+++ b/TIFFReader.st Fri Jun 03 06:44:03 2016 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
@@ -23,6 +25,13 @@
category:'Graphics-Images-Readers'
!
+Dictionary subclass:#TIFFMetaData
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:TIFFReader
+!
+
!TIFFReader class methodsFor:'documentation'!
copyright
@@ -186,7 +195,7 @@
"/ MASK -> 4
"newSubFileType := value."
- "/ 'newSubfiletype ' print. value printNewline.
+ "/ 'newSubfiletype ' print. value printNewline.
^ self
].
@@ -197,7 +206,7 @@
"/ PAGE -> 3
subFileType := value.
- "/ 'subfiletype ' print. value printNewline.
+ "/ 'subfiletype ' print. value printNewline.
^ self
].
@@ -205,7 +214,7 @@
"ImageWidth"
width := value.
- "/ 'width ' print. width printNewline.
+ "/ 'width ' print. width printNewline.
^ self
].
@@ -213,7 +222,7 @@
"ImageHeight"
height := value.
- "/ 'height ' print. height printNewline.
+ "/ 'height ' print. height printNewline.
^ self
].
@@ -221,7 +230,7 @@
"bitspersample"
bitsPerSample := valueArray.
- "/ 'bitspersample ' print. bitsPerSample printNewline.
+ "/ 'bitspersample ' print. bitsPerSample printNewline.
^ self
].
@@ -246,7 +255,7 @@
compression := value.
- "/ 'compression ' print. compression printNewline.
+ "/ 'compression ' print. compression printNewline.
^ self
].
@@ -287,7 +296,7 @@
]
].
- "/ 'photometric ' print. photometric printNewline.
+ "/ 'photometric ' print. photometric printNewline.
^ self
].
@@ -299,24 +308,21 @@
"threshholding := value."
- "/ 'treshholding ' print. value printNewline.
+ "/ 'treshholding ' print. value printNewline.
^ self
].
(tagType == 264) ifTrue:[
"CellWidth"
- "cellWidth:= value."
-
- "/ 'cellWidth ' print. value printNewline.
+ "/ 'cellWidth ' print. value printNewline.
+ metaData at:#CellWidth put:value.
^ self
].
(tagType == 265) ifTrue:[
"CellLength"
- "cellLength:= value."
-
- "/ 'cellLength ' print. value printNewline.
-
+ "/ 'cellLength ' print. value printNewline.
+ metaData at:#CellLength put:value.
^ self
].
(tagType == 266) ifTrue:[
@@ -331,44 +337,38 @@
]
].
- "/ 'fillorder ' print. fillOrder printNewline.
+ "/ 'fillorder ' print. fillOrder printNewline.
^ self
].
(tagType == 269) ifTrue:[
"documentName - info only"
-
- "/ 'documentName ' print. value printNewline.
-
+ "/ 'documentName ' print. value printNewline.
+ metaData at:#DocumentName put:value.
^ self
].
(tagType == 270) ifTrue:[
"imageDescription - info only"
-
- "/ 'imageDescription ' print. value printNewline.
-
+ "/ 'imageDescription ' print. value printNewline.
+ metaData at:#ImageDescription put:value.
^ self
].
(tagType == 271) ifTrue:[
"make - info only"
-
- "/ 'make ' print. value printNewline.
-
+ "/ 'make ' print. value printNewline.
+ metaData at:#Make put:value.
^ self
].
(tagType == 272) ifTrue:[
"model - info only"
-
- "/ 'model ' print. value printNewline.
-
+ "/ 'model ' print. value printNewline.
+ metaData at:#Model put:value.
^ self
].
(tagType == 273) ifTrue:[
"stripoffsets"
stripOffsets := valueArray.
-
- "/ 'stripOffsets Array(' print. stripOffsets size print. ')' printNewline.
-
+ "/ 'stripOffsets Array(' print. stripOffsets size print. ')' printNewline.
^ self
].
(tagType == 274) ifTrue:[
@@ -384,65 +384,52 @@
unsupported "/ 7 rot 90' & flip
unsupported "/ 8 rot 90' ccw & flip
) at:value ifAbsent:#unsupported.
-
- "/ 'orientation ' print. value printNewline.
-
+ metaData at:#Orientation put:value.
+ "/ 'orientation ' print. value printNewline.
^ self
].
(tagType == 277) ifTrue:[
"samplesPerPixel"
samplesPerPixel := value.
-
- "/ 'samplesperpixel ' print. samplesPerPixel printNewline.
-
+ "/ 'samplesperpixel ' print. samplesPerPixel printNewline.
^ self
].
(tagType == 278) ifTrue:[
"rowsperstrip"
rowsPerStrip := value.
-
- "/ 'rowsperstrip ' print. rowsPerStrip printNewline.
-
+ "/ 'rowsperstrip ' print. rowsPerStrip printNewline.
^ self
].
(tagType == 279) ifTrue:[
"stripbytecount"
stripByteCounts := valueArray.
-
- "/ 'stripByteCounts Array(' print.
- "/ stripByteCounts size print.
- "/ ')' printNewline.
-
+ "/ 'stripByteCounts Array(' print.
+ "/ stripByteCounts size print.
+ "/ ')' printNewline.
^ self
].
(tagType == 280) ifTrue:[
"MinSampleValue"
- "minSampleValue:= value."
-
- "/ 'minSampleValue ' print. value printNewline.
-
+ "/ 'minSampleValue ' print. value printNewline.
+ metaData at:#MinSampleValue put:value.
^ self
].
(tagType == 281) ifTrue:[
"MaxSampleValue"
- "maxSampleValue:= value."
-
- "/ 'maxSampleValue ' print. value printNewline.
-
+ "/ 'maxSampleValue ' print. value printNewline.
+ metaData at:#MaxSampleValue put:value.
^ self
].
(tagType == 282) ifTrue:[
"xResolution"
-
- "/ 'xres ' print. value printNewline.
-
+ "/ 'xres ' print. value printNewline.
+ metaData at:#ResolutionX put:value.
^ self
].
(tagType == 283) ifTrue:[
"yResolution"
-
- "/ 'yres ' print. value printNewline.
-
+ "/ 'yres ' print. value printNewline.
+ metaData at:#ResolutionY put:value.
^ self
].
(tagType == 284) ifTrue:[
@@ -456,58 +443,47 @@
planarConfiguration := nil
]
].
-
- "/ 'planarconfig ' print. planarConfiguration printNewline.
-
+ "/ 'planarconfig ' print. planarConfiguration printNewline.
^ self
].
(tagType == 285) ifTrue:[
"pageName"
-
- "/ 'pageName ' print. value printNewline.
-
+ "/ 'pageName ' print. value printNewline.
+ metaData at:#PageName put:value.
^ self
].
(tagType == 286) ifTrue:[
"xPosition"
-
- "/ 'xPos ' print. value printNewline.
-
+ "/ 'xPos ' print. value printNewline.
+ metaData at:#PositionX put:value.
^ self
].
(tagType == 287) ifTrue:[
"yPosition"
-
- "/ 'yPos ' print. value printNewline.
-
+ "/ 'yPos ' print. value printNewline.
+ metaData at:#PositionY put:value.
^ self
].
(tagType == 288) ifTrue:[
"freeOffsets"
-
- "/ 'freeOffsets ' print. value printNewline.
-
+ "/ 'freeOffsets ' print. value printNewline.
^ self
].
(tagType == 289) ifTrue:[
"freeByteCounts"
-
- "/ 'freeByteCounts ' print. value printNewline.
-
+ "/ 'freeByteCounts ' print. value printNewline.
^ self
].
(tagType == 290) ifTrue:[
"grayResponceUnit"
-
- "/ 'grayResponceUnit' print. value printNewline.
-
+ "/ 'grayResponceUnit' print. value printNewline.
+ metaData at:#GrayResponceUnit put:value.
^ self
].
(tagType == 291) ifTrue:[
"grayResponceCurve"
-
- "/ 'grayResponceCurve' print. value printNewline.
-
+ "/ 'grayResponceCurve' print. value printNewline.
+ metaData at:#GrayResponceCurve put:value.
^ self
].
(tagType == 292) ifTrue:[
@@ -517,9 +493,7 @@
"/ FILLBITS -> 4
group3options := value.
-
- "/ 'group3options ' print. group3options printNewline.
-
+ "/ 'group3options ' print. group3options printNewline.
^ self
].
(tagType == 293) ifTrue:[
@@ -527,9 +501,7 @@
"/ UNCOMPRESSED -> 2
"group4options := value."
-
- "/ 'group4options ' print. value printNewline.
-
+ "/ 'group4options ' print. value printNewline.
^ self
].
(tagType == 296) ifTrue:[
@@ -548,16 +520,13 @@
"/ ]
"/ ]
"/ ].
-
- "resolutionUnit := value."
+ metaData at:#ResolutionUnit put:value.
^ self
].
(tagType == 297) ifTrue:[
"pageNumber"
- "pageNumber := value."
-
- "/ 'pageNumber ' print. value printNewline.
-
+ "/ 'pageNumber ' print. value printNewline.
+ metaData at:#PageNumber put:value.
^ self
].
].
@@ -565,72 +534,62 @@
(tagType < 400) ifTrue:[
(tagType == 300) ifTrue:[
"colorResponceUnit"
-
- "/ 'colorResponceUnit' print. value printNewline.
-
+ "/ 'colorResponceUnit' print. value printNewline.
+ metaData at:#ColorResponceUnit put:value.
^ self
].
(tagType == 301) ifTrue:[
"colorResponceCurve"
-
- "/ 'colorResponceCurve' print. value printNewline.
-
+ "/ 'colorResponceCurve' print. value printNewline.
+ metaData at:#ColorResponceCurve put:value.
^ self
].
(tagType == 305) ifTrue:[
"software - info only"
-
- "/ 'software' print. value printNewline.
-
+ "/ 'software' print. value printNewline.
+ metaData at:#Software put:value.
^ self
].
(tagType == 306) ifTrue:[
"dateTime - info only"
-
- "/ 'dateTime ' print. value printNewline.
-
+ "/ 'dateTime ' print. value printNewline.
+ metaData at:#DateTime put:value.
^ self
].
(tagType == 315) ifTrue:[
"artist - info only"
-
- "/ 'artist ' print. value printNewline.
-
+ "/ 'artist ' print. value printNewline.
+ metaData at:#Artist put:value.
^ self
].
(tagType == 316) ifTrue:[
"host computer - info only"
-
- "/ 'host ' print. value printNewline.
-
+ "/ 'host ' print. value printNewline.
+ metaData at:#HostComputer put:value.
^ self
].
(tagType == 317) ifTrue:[
"predictor"
predictor := value.
-
- "/ 'predictor ' print. predictor printNewline.
-
+ "/ 'predictor ' print. predictor printNewline.
^ self
].
(tagType == 318) ifTrue:[
"whitePoint"
-
- "/ 'whitePoint ' print. value printNewline.
-
+ "/ 'whitePoint ' print. value printNewline.
+ metaData at:#WhitePoint put:value.
^ self
].
(tagType == 319) ifTrue:[
"primaryChromatics"
-
- "/ 'primaryChromatics ' print. value printNewline.
-
+ "/ 'primaryChromatics ' print. value printNewline.
+ metaData at:#PrimaryChromatics put:value.
^ self
].
(tagType == 320) ifTrue:[
"ColorMap"
- "/ 'colorMap (size=' print. valueArray size print. ')' printNewline.
+ "/ 'colorMap (size=' print. valueArray size print. ')' printNewline.
"
the tiff colormap contains 16bit values;
@@ -659,44 +618,37 @@
].
(tagType == 321) ifTrue:[
"halftonehints"
-
- "/ 'halftonehints' print. value printNewline.
-
+ "/ 'halftonehints' print. value printNewline.
+ metaData at:#HalftoneHints put:value.
^ self
].
(tagType == 322) ifTrue:[
"tilewidth"
-
- "/ 'tilewidth' print. value printNewline.
-
+ "/ 'tilewidth' print. value printNewline.
+ metaData at:#TileWidth put:value.
^ self
].
(tagType == 323) ifTrue:[
"tilelength"
-
- "/ 'tilelength' print. value printNewline.
-
+ "/ 'tilelength' print. value printNewline.
+ metaData at:#TileLength put:value.
^ self
].
(tagType == 324) ifTrue:[
"tileoffsets"
-
- "/ 'tileoffsets' print. value printNewline.
-
+ "/ 'tileoffsets' print. value printNewline.
+ metaData at:#TileOffsets put:value.
^ self
].
(tagType == 325) ifTrue:[
"tilebytecounts"
-
- "/ 'tilebytecounts' print. value printNewline.
-
+ "/ 'tilebytecounts' print. value printNewline.
+ metaData at:#TileByteCounts put:value.
^ self
].
(tagType == 326) ifTrue:[
"BadFaxLines"
-
- "/ 'badFaxLines' print. value printNewline.
-
+ "/ 'badFaxLines' print. value printNewline.
^ self
].
(tagType == 327) ifTrue:[
@@ -743,35 +695,33 @@
(tagType == 333) ifTrue:[
"ink names"
- "/ 'ink names' print. value printNewline.
-
+ "/ 'ink names' print. value printNewline.
+ metaData at:#IncNames put:value.
^ self
].
(tagType == 336) ifTrue:[
"dot range"
- "/ 'dot range' print. value printNewline.
-
+ "/ 'dot range' print. value printNewline.
^ self
].
(tagType == 337) ifTrue:[
"target printer"
- "/ 'target printer' print. value printNewline.
-
+ "/ 'target printer' print. value printNewline.
^ self
].
(tagType == 338) ifTrue:[
"extrasamples"
- "/ 'extrasamples' print. value printNewline.
+ "/ 'extrasamples' print. value printNewline.
^ self
].
(tagType == 339) ifTrue:[
"sample format"
- "/ 'sample format' print. value printNewline.
+ "/ 'sample format' print. value printNewline.
^ self
].
@@ -2127,7 +2077,8 @@
].
"setup default values"
-
+ metaData := TIFFMetaData new.
+
compression := 1. "none"
fillOrder := #msb.
planarConfiguration := 1.
@@ -2206,7 +2157,7 @@
tmp := ByteArray new:bytesPerRow.
offset1 := 1.
offset2 := (height-1)*bytesPerRow + 1.
- 0 to:(height-1//2) do:[:row |
+ 0 to:((height-1)//2) do:[:row |
tmp replaceFrom:1 to:bytesPerRow
with:data startingAt:offset1.
data replaceFrom:offset1 to:offset1+bytesPerRow-1