--- a/JPEGReader.st Mon Oct 10 03:32:51 1994 +0100
+++ b/JPEGReader.st Mon Oct 10 03:34:22 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -11,17 +11,17 @@
"
ImageReader subclass:#JPEGReader
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
JPEGReader comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libview2/JPEGReader.st,v 1.5 1994-08-05 01:14:31 claus Exp $
+$Header: /cvs/stx/stx/libview2/JPEGReader.st,v 1.6 1994-10-10 02:32:33 claus Exp $
'!
!JPEGReader class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/JPEGReader.st,v 1.5 1994-08-05 01:14:31 claus Exp $
+$Header: /cvs/stx/stx/libview2/JPEGReader.st,v 1.6 1994-10-10 02:32:33 claus Exp $
"
!
@@ -54,6 +54,14 @@
"
! !
+!JPEGReader class methodsFor:'initialization'!
+
+initialize
+ Image fileFormats at:'.jpg' put:self.
+ Image fileFormats at:'.jpeg' put:self.
+ Image fileFormats at:'.JPG' put:self.
+! !
+
!JPEGReader methodsFor:'reading from file'!
fromFile:aFileName
@@ -66,9 +74,9 @@
Transcript showCr:'converting to gif ..'.
(OperatingSystem executeCommand:'djpeg -gif ' , aFileName , ' > ' , tempFileName)
ifTrue:[
- reader := GIFReader fromFile:tempFileName.
- OperatingSystem executeCommand:'rm ' , tempFileName.
- ^ reader
+ reader := GIFReader fromFile:tempFileName.
+ OperatingSystem executeCommand:'rm ' , tempFileName.
+ ^ reader
].
Transcript showCr:'conversion failed ..'.
self warn:'cannot execute jpeg converter: djpeg'.
--- a/Model.st Mon Oct 10 03:32:51 1994 +0100
+++ b/Model.st Mon Oct 10 03:34:22 1994 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview2/Model.st,v 1.6 1994-08-05 01:14:35 claus Exp $
+$Header: /cvs/stx/stx/libview2/Model.st,v 1.7 1994-10-10 02:32:42 claus Exp $
'!
!Model class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/Model.st,v 1.6 1994-08-05 01:14:35 claus Exp $
+$Header: /cvs/stx/stx/libview2/Model.st,v 1.7 1994-10-10 02:32:42 claus Exp $
"
!
@@ -72,6 +72,14 @@
dependents := aCollection
! !
+!Model methodsFor:'copying'!
+
+postCopy
+ "release dependents after copying"
+
+ self dependents:nil
+! !
+
!Model methodsFor:'drawing'!
displayOn:aGraphicsContext clippingBox:aRectangle
--- a/PBMReader.st Mon Oct 10 03:32:51 1994 +0100
+++ b/PBMReader.st Mon Oct 10 03:34:22 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1992 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -11,17 +11,17 @@
"
ImageReader subclass:#PBMReader
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
PBMReader comment:'
COPYRIGHT (c) 1992 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libview2/PBMReader.st,v 1.6 1994-08-05 01:14:51 claus Exp $
+$Header: /cvs/stx/stx/libview2/PBMReader.st,v 1.7 1994-10-10 02:32:49 claus Exp $
'!
!PBMReader class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1992 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/PBMReader.st,v 1.6 1994-08-05 01:14:51 claus Exp $
+$Header: /cvs/stx/stx/libview2/PBMReader.st,v 1.7 1994-10-10 02:32:49 claus Exp $
"
!
@@ -53,6 +53,14 @@
"
! !
+!PBMReader class methodsFor:'initialization'!
+
+initialize
+ Image fileFormats at:'.pbm' put:self.
+ Image fileFormats at:'.pgm' put:self.
+ Image fileFormats at:'.pnm' put:self.
+! !
+
!PBMReader methodsFor:'private'!
skipPBMJunkOn: aStream
@@ -61,16 +69,16 @@
| char foundNL|
[
- char := aStream peek.
- char == $# ifTrue:[
- "Start of a comment. Skip to end-of-line."
- foundNL := (aStream skipUpTo: Character cr) notNil.
- foundNL ifFalse: [
- "Must be EOF"
- ^self
- ].
- char := aStream peek].
- aStream atEnd not and: [char isSeparator]
+ char := aStream peek.
+ char == $# ifTrue:[
+ "Start of a comment. Skip to end-of-line."
+ foundNL := (aStream skipUpTo: Character cr) notNil.
+ foundNL ifFalse: [
+ "Must be EOF"
+ ^self
+ ].
+ char := aStream peek].
+ aStream atEnd not and: [char isSeparator]
] whileTrue: [aStream next]
!
@@ -80,21 +88,23 @@
| char |
[
- char := aStream peek.
- aStream atEnd not and: [char isSeparator not]
+ char := aStream peek.
+ aStream atEnd not and: [char isSeparator not]
] whileTrue: [aStream next].
[aStream atEnd not and: [char isSeparator]] whileTrue: [
- aStream next. char := aStream peek
+ aStream next. char := aStream peek
].
aStream atEnd ifTrue: [^char].
(char isDigit) ifTrue: [ ^char ].
(char == $") ifTrue: [
- aStream next.
- char := aStream peek.
- ((char isAlphaNumeric or: [char = $#]) or: [char = Character space]) ifFalse:[
- ^self skipXPMJunkOn: aStream
- ] ifTrue: [^char]
+ aStream next.
+ char := aStream peek.
+ (char isLetterOrDigit
+ or: [(char == $#)
+ or: [char == Character space]]) ifFalse:[
+ ^ self skipXPMJunkOn: aStream
+ ] ifTrue: [^char]
].
^self skipXPMJunkOn: aStream.
@@ -107,8 +117,8 @@
outStream := FileStream newFileNamed:aFileName.
outStream isNil ifTrue:[
- 'create error' errorPrintNL.
- ^ nil
+ 'create error' errorPrintNL.
+ ^ nil
].
width := image width.
@@ -119,15 +129,15 @@
colorMap := image colorMap.
photometric == #rgb ifTrue:[
- ^ self writePNMFile
+ ^ self writePNMFile
].
samplesPerPixel == 1 ifTrue:[
- ((bitsPerSample at:1) == 1) ifTrue:[
- ^ self writePBMFile
- ].
- ((bitsPerSample at:1) == 8) ifTrue:[
- ^ self writePGMFile
- ].
+ ((bitsPerSample at:1) == 1) ifTrue:[
+ ^ self writePBMFile
+ ].
+ ((bitsPerSample at:1) == 8) ifTrue:[
+ ^ self writePGMFile
+ ].
].
self error:'format not supported'.
!
@@ -156,20 +166,20 @@
inStream isNil ifTrue:[^ nil].
inStream next == $P ifFalse:[
- ('not PNM format in ', fileName) errorPrintNL.
- inStream close.
- ^nil
+ ('not PNM format in ', fileName) errorPrintNL.
+ inStream close.
+ ^nil
].
pnmType := inStream next.
inStream close.
pnmType == $4 ifTrue: [
- ^ self readDepth1PBMFile:fileName
+ ^ self readDepth1PBMFile:fileName
].
pnmType == $5 ifTrue: [
- ^ self readDepth8PGMFile:fileName
+ ^ self readDepth8PGMFile:fileName
].
pnmType == $6 ifTrue: [
- ^ self readDepth24PPMFile:fileName
+ ^ self readDepth24PPMFile:fileName
].
('No recognized pnm file format in ', fileName) errorPrintNL.
^ nil
@@ -184,31 +194,31 @@
inStream isNil ifTrue:[^ nil].
(inStream next == $P) ifFalse: [
- inStream close.
- 'not a pbm file format' errorPrintNL.
- ^ nil
+ inStream close.
+ 'not a pbm file format' errorPrintNL.
+ ^ nil
].
(inStream next == $4) ifFalse:[
- inStream close.
- 'not a pbm file format' errorPrintNL.
- ^ nil
+ inStream close.
+ 'not a pbm file format' errorPrintNL.
+ ^ nil
].
self skipPBMJunkOn: inStream.
width := Integer readFrom: inStream.
width > 0 ifFalse: [
- inStream close.
- 'Invalid width' errorPrintNL.
- ^ nil
+ inStream close.
+ 'Invalid width' errorPrintNL.
+ ^ nil
].
self skipPBMJunkOn: inStream.
height := Integer readFrom: inStream.
height > 0 ifFalse: [
- inStream close.
- 'Invalid height' errorPrintNL.
- ^ nil
+ inStream close.
+ 'Invalid height' errorPrintNL.
+ ^ nil
].
inStream nextLine "skipThrough: Character cr".
@@ -230,35 +240,35 @@
inStream isNil ifTrue:[^ nil].
inStream next == $P ifFalse:[
- inStream close.
- 'not a pgm file format' errorPrintNL.
- ^ nil
+ inStream close.
+ 'not a pgm file format' errorPrintNL.
+ ^ nil
].
inStream next == $5 ifFalse:[
- inStream close.
- 'not a pgm file format' errorPrintNL.
- ^ nil
+ inStream close.
+ 'not a pgm file format' errorPrintNL.
+ ^ nil
].
self skipPBMJunkOn: inStream.
width := Integer readFrom: inStream.
width > 0 ifFalse:[
- inStream close.
- 'pgm read error' errorPrintNL.
- ^ nil
+ inStream close.
+ 'pgm read error' errorPrintNL.
+ ^ nil
].
self skipPBMJunkOn: inStream.
height := Integer readFrom: inStream.
height > 0 ifFalse:[
- inStream close.
- 'pgm read error' errorPrintNL.
- ^ nil
+ inStream close.
+ 'pgm read error' errorPrintNL.
+ ^ nil
].
self skipPBMJunkOn: inStream.
maxval := Integer readFrom: inStream.
maxval >= 256 ifTrue:[
- inStream close.
- 'pgm read error' errorPrintNL.
- ^ nil
+ inStream close.
+ 'pgm read error' errorPrintNL.
+ ^ nil
].
inStream skipThrough: Character cr.
inStream binary.
@@ -278,39 +288,39 @@
inStream isNil ifTrue:[^ nil].
(inStream next == $P) ifFalse: [
- inStream close.
- self error: 'not a ppm file format' errorPrintNL.
- ^ nil
+ inStream close.
+ self error: 'not a ppm file format' errorPrintNL.
+ ^ nil
].
(inStream next == $6) ifFalse: [
- inStream close.
- self error: 'not a ppm file format' errorPrintNL.
- ^ nil
+ inStream close.
+ self error: 'not a ppm file format' errorPrintNL.
+ ^ nil
].
self skipPBMJunkOn: inStream.
width := Integer readFrom: inStream.
width > 0 ifFalse: [
- inStream close.
- self error: 'ppm read error' errorPrintNL.
- ^ nil
+ inStream close.
+ self error: 'ppm read error' errorPrintNL.
+ ^ nil
].
self skipPBMJunkOn: inStream.
height := Integer readFrom: inStream.
height > 0 ifFalse: [
- inStream close.
- self error: 'ppm read error' errorPrintNL.
- ^ nil
+ inStream close.
+ self error: 'ppm read error' errorPrintNL.
+ ^ nil
].
self skipPBMJunkOn: inStream.
maxval := Integer readFrom: inStream.
maxval >= 256 ifTrue: [
- inStream close.
- self error: 'ppm read error' errorPrintNL.
- ^ nil
+ inStream close.
+ self error: 'ppm read error' errorPrintNL.
+ ^ nil
].
inStream skipThrough: Character cr.
--- a/SunRasterReader.st Mon Oct 10 03:32:51 1994 +0100
+++ b/SunRasterReader.st Mon Oct 10 03:34:22 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -11,17 +11,17 @@
"
ImageReader subclass:#SunRasterReader
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
SunRasterReader comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libview2/SunRasterReader.st,v 1.7 1994-08-05 01:15:11 claus Exp $
+$Header: /cvs/stx/stx/libview2/SunRasterReader.st,v 1.8 1994-10-10 02:33:19 claus Exp $
'!
!SunRasterReader class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/SunRasterReader.st,v 1.7 1994-08-05 01:15:11 claus Exp $
+$Header: /cvs/stx/stx/libview2/SunRasterReader.st,v 1.8 1994-10-10 02:33:19 claus Exp $
"
!
@@ -52,6 +52,12 @@
"
! !
+!SunRasterReader class methodsFor:'initialization'!
+
+initialize
+ Image fileFormats at:'.icon' put:self.
+! !
+
!SunRasterReader class methodsFor:'testing'!
isValidImageFile:aFileName
@@ -66,33 +72,33 @@
inStream binary.
((inStream nextWord == 16r59A6)
and:[inStream nextWord == 16r6A95]) ifTrue: [
- inStream close.
- ^ true
+ inStream close.
+ ^ true
].
"try sun bitmap image format"
inStream text.
inStream reset.
(inStream skipThroughAll: 'idth') isNil ifTrue: [
- inStream close.
- ^ false
+ inStream close.
+ ^ false
].
inStream next; skipSeparators.
nr := Integer readFrom: inStream.
(nr isNil or:[nr <= 0]) ifTrue: [
- inStream close.
- ^ false
+ inStream close.
+ ^ false
].
(inStream skipThroughAll: 'eight') isNil ifTrue: [
- inStream close.
- ^ false
+ inStream close.
+ ^ false
].
inStream next; skipSeparators.
nr := Integer readFrom: inStream.
(nr isNil or:[nr <= 0]) ifTrue: [
- inStream close.
- ^ false
+ inStream close.
+ ^ false
].
inStream close.
@@ -113,8 +119,8 @@
((inStream nextWord == 16r59A6)
and:[inStream nextWord == 16r6A95]) ifFalse: [
- inStream close.
- ^ self fromSunIconFile:aFilename
+ inStream close.
+ ^ self fromSunIconFile:aFilename
].
width := inStream nextLong.
@@ -127,27 +133,27 @@
mapBytes := inStream nextLong.
depth = 8 ifTrue: [
- mapLen := (mapBytes // 3).
- rMap := ByteArray uninitializedNew:mapLen.
- gMap := ByteArray uninitializedNew:mapLen.
- bMap := ByteArray uninitializedNew:mapLen.
- inStream nextBytes:mapLen into:rMap.
- inStream nextBytes:mapLen into:gMap.
- inStream nextBytes:mapLen into:bMap.
+ mapLen := (mapBytes // 3).
+ rMap := ByteArray uninitializedNew:mapLen.
+ gMap := ByteArray uninitializedNew:mapLen.
+ bMap := ByteArray uninitializedNew:mapLen.
+ inStream nextBytes:mapLen into:rMap.
+ inStream nextBytes:mapLen into:gMap.
+ inStream nextBytes:mapLen into:bMap.
- data := ByteArray uninitializedNew:(width * height).
- inStream nextBytes:(width * height) into:data.
+ data := ByteArray uninitializedNew:(width * height).
+ inStream nextBytes:(width * height) into:data.
- photometric := #palette.
- samplesPerPixel := 1.
- bitsPerSample := #(8).
- colorMap := Array with:rMap with:gMap with:bMap.
- inStream close.
- ^ self
+ photometric := #palette.
+ samplesPerPixel := 1.
+ bitsPerSample := #(8).
+ colorMap := Array with:rMap with:gMap with:bMap.
+ inStream close.
+ ^ self
].
depth ~~ 1 ifTrue: [
- inStream close.
- self error: 'Raster file is not monochrome'
+ inStream close.
+ self error: 'Raster file is not monochrome'
].
form := nil.
@@ -157,39 +163,39 @@
data := ByteArray uninitializedNew:(imageWords * 2).
(rasterType between: 0 and: 2) ifFalse: [
- inStream close.
- self error: 'Unknown raster file rasterType'
+ inStream close.
+ self error: 'Unknown raster file rasterType'
].
(rasterType = 2) ifFalse: [
- "no compression of bytes"
- inStream nextBytes:(imageWords * 2) into:data
+ "no compression of bytes"
+ inStream nextBytes:(imageWords * 2) into:data
] ifTrue: [
- "run length compression of bytes"
+ "run length compression of bytes"
- bits _ ByteArray uninitializedNew: imageWords * 2.
- index := 1.
- a _ inStream next.
- [a notNil] whileTrue: [
- (a = 128) ifFalse: [
- bits at:index put: a.
- index := index + 1
- ] ifTrue: [
- b _ inStream next.
- b = 0 ifTrue: [
- bits at:index put:128 .
- index := index + 1
- ] ifFalse: [
- c := inStream next.
- 1 to:(b+1) do:[:i |
- bits at:index put:c.
- index := index + 1
- ]
- ]
- ].
- a _ inStream next
- ].
- 1 to: imageWords do: [:i | form bitsWordAt: i put: (bits wordAt: i)]
+ bits _ ByteArray uninitializedNew: imageWords * 2.
+ index := 1.
+ a _ inStream next.
+ [a notNil] whileTrue: [
+ (a = 128) ifFalse: [
+ bits at:index put: a.
+ index := index + 1
+ ] ifTrue: [
+ b _ inStream next.
+ b = 0 ifTrue: [
+ bits at:index put:128 .
+ index := index + 1
+ ] ifFalse: [
+ c := inStream next.
+ 1 to:(b+1) do:[:i |
+ bits at:index put:c.
+ index := index + 1
+ ]
+ ]
+ ].
+ a _ inStream next
+ ].
+ 1 to: imageWords do: [:i | form bitsWordAt: i put: (bits wordAt: i)]
].
photometric := #whiteIs0.
samplesPerPixel := 1.
@@ -208,30 +214,30 @@
inStream isNil ifTrue:[^ nil].
(inStream skipThroughAll:'idth') isNil ifTrue: [
- 'Not a Sun Raster/Icon File' errorPrintNewline.
- inStream close.
- ^nil
+ 'Not a Sun Raster/Icon File' errorPrintNewline.
+ inStream close.
+ ^nil
].
inStream next; skipSeparators. "skip $="
width := Integer readFrom: inStream.
(width isNil or:[width <= 0]) ifTrue: [
- 'format error (expected number)' errorPrintNewline.
- inStream close.
- ^ nil
+ 'format error (expected number)' errorPrintNewline.
+ inStream close.
+ ^ nil
].
w := width.
(inStream skipThroughAll:'eight') isNil ifTrue: [
- 'format error (expected height)' errorPrintNewline.
- inStream close.
- ^ nil
+ 'format error (expected height)' errorPrintNewline.
+ inStream close.
+ ^ nil
].
inStream next; skipSeparators. "skip $="
height := Integer readFrom: inStream.
(height isNil or:[height <= 0]) ifTrue: [
- 'format error (expected number)' errorPrintNewline.
- inStream close.
- ^nil
+ 'format error (expected number)' errorPrintNewline.
+ inStream close.
+ ^nil
].
h := height.
@@ -242,18 +248,18 @@
index := 0.
1 to:h do: [:row |
- 1 to: (w + 15 // 16) do: [:col |
- "rows are rounded up to next multiple of 16 bits"
- (inStream skipThroughAll:'0x') isNil ifTrue: [^ nil].
- word := Integer readFrom:inStream radix:16.
- word isNil ifTrue:[
- 'format error' errorPrintNewline.
- inStream close.
- ^ nil
- ].
- data at: (index _ index + 1) put: (word bitShift:-8).
- data at: (index _ index + 1) put: (word bitAnd:16rFF).
- ]
+ 1 to: (w + 15 // 16) do: [:col |
+ "rows are rounded up to next multiple of 16 bits"
+ (inStream skipThroughAll:'0x') isNil ifTrue: [^ nil].
+ word := Integer readFrom:inStream radix:16.
+ word isNil ifTrue:[
+ 'format error' errorPrintNewline.
+ inStream close.
+ ^ nil
+ ].
+ data at: (index _ index + 1) put: (word bitShift:-8).
+ data at: (index _ index + 1) put: (word bitAnd:16rFF).
+ ]
].
inStream close.
! !
--- a/SunReader.st Mon Oct 10 03:32:51 1994 +0100
+++ b/SunReader.st Mon Oct 10 03:34:22 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -11,17 +11,17 @@
"
ImageReader subclass:#SunRasterReader
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
SunRasterReader comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libview2/Attic/SunReader.st,v 1.7 1994-08-05 01:15:11 claus Exp $
+$Header: /cvs/stx/stx/libview2/Attic/SunReader.st,v 1.8 1994-10-10 02:33:19 claus Exp $
'!
!SunRasterReader class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/Attic/SunReader.st,v 1.7 1994-08-05 01:15:11 claus Exp $
+$Header: /cvs/stx/stx/libview2/Attic/SunReader.st,v 1.8 1994-10-10 02:33:19 claus Exp $
"
!
@@ -52,6 +52,12 @@
"
! !
+!SunRasterReader class methodsFor:'initialization'!
+
+initialize
+ Image fileFormats at:'.icon' put:self.
+! !
+
!SunRasterReader class methodsFor:'testing'!
isValidImageFile:aFileName
@@ -66,33 +72,33 @@
inStream binary.
((inStream nextWord == 16r59A6)
and:[inStream nextWord == 16r6A95]) ifTrue: [
- inStream close.
- ^ true
+ inStream close.
+ ^ true
].
"try sun bitmap image format"
inStream text.
inStream reset.
(inStream skipThroughAll: 'idth') isNil ifTrue: [
- inStream close.
- ^ false
+ inStream close.
+ ^ false
].
inStream next; skipSeparators.
nr := Integer readFrom: inStream.
(nr isNil or:[nr <= 0]) ifTrue: [
- inStream close.
- ^ false
+ inStream close.
+ ^ false
].
(inStream skipThroughAll: 'eight') isNil ifTrue: [
- inStream close.
- ^ false
+ inStream close.
+ ^ false
].
inStream next; skipSeparators.
nr := Integer readFrom: inStream.
(nr isNil or:[nr <= 0]) ifTrue: [
- inStream close.
- ^ false
+ inStream close.
+ ^ false
].
inStream close.
@@ -113,8 +119,8 @@
((inStream nextWord == 16r59A6)
and:[inStream nextWord == 16r6A95]) ifFalse: [
- inStream close.
- ^ self fromSunIconFile:aFilename
+ inStream close.
+ ^ self fromSunIconFile:aFilename
].
width := inStream nextLong.
@@ -127,27 +133,27 @@
mapBytes := inStream nextLong.
depth = 8 ifTrue: [
- mapLen := (mapBytes // 3).
- rMap := ByteArray uninitializedNew:mapLen.
- gMap := ByteArray uninitializedNew:mapLen.
- bMap := ByteArray uninitializedNew:mapLen.
- inStream nextBytes:mapLen into:rMap.
- inStream nextBytes:mapLen into:gMap.
- inStream nextBytes:mapLen into:bMap.
+ mapLen := (mapBytes // 3).
+ rMap := ByteArray uninitializedNew:mapLen.
+ gMap := ByteArray uninitializedNew:mapLen.
+ bMap := ByteArray uninitializedNew:mapLen.
+ inStream nextBytes:mapLen into:rMap.
+ inStream nextBytes:mapLen into:gMap.
+ inStream nextBytes:mapLen into:bMap.
- data := ByteArray uninitializedNew:(width * height).
- inStream nextBytes:(width * height) into:data.
+ data := ByteArray uninitializedNew:(width * height).
+ inStream nextBytes:(width * height) into:data.
- photometric := #palette.
- samplesPerPixel := 1.
- bitsPerSample := #(8).
- colorMap := Array with:rMap with:gMap with:bMap.
- inStream close.
- ^ self
+ photometric := #palette.
+ samplesPerPixel := 1.
+ bitsPerSample := #(8).
+ colorMap := Array with:rMap with:gMap with:bMap.
+ inStream close.
+ ^ self
].
depth ~~ 1 ifTrue: [
- inStream close.
- self error: 'Raster file is not monochrome'
+ inStream close.
+ self error: 'Raster file is not monochrome'
].
form := nil.
@@ -157,39 +163,39 @@
data := ByteArray uninitializedNew:(imageWords * 2).
(rasterType between: 0 and: 2) ifFalse: [
- inStream close.
- self error: 'Unknown raster file rasterType'
+ inStream close.
+ self error: 'Unknown raster file rasterType'
].
(rasterType = 2) ifFalse: [
- "no compression of bytes"
- inStream nextBytes:(imageWords * 2) into:data
+ "no compression of bytes"
+ inStream nextBytes:(imageWords * 2) into:data
] ifTrue: [
- "run length compression of bytes"
+ "run length compression of bytes"
- bits _ ByteArray uninitializedNew: imageWords * 2.
- index := 1.
- a _ inStream next.
- [a notNil] whileTrue: [
- (a = 128) ifFalse: [
- bits at:index put: a.
- index := index + 1
- ] ifTrue: [
- b _ inStream next.
- b = 0 ifTrue: [
- bits at:index put:128 .
- index := index + 1
- ] ifFalse: [
- c := inStream next.
- 1 to:(b+1) do:[:i |
- bits at:index put:c.
- index := index + 1
- ]
- ]
- ].
- a _ inStream next
- ].
- 1 to: imageWords do: [:i | form bitsWordAt: i put: (bits wordAt: i)]
+ bits _ ByteArray uninitializedNew: imageWords * 2.
+ index := 1.
+ a _ inStream next.
+ [a notNil] whileTrue: [
+ (a = 128) ifFalse: [
+ bits at:index put: a.
+ index := index + 1
+ ] ifTrue: [
+ b _ inStream next.
+ b = 0 ifTrue: [
+ bits at:index put:128 .
+ index := index + 1
+ ] ifFalse: [
+ c := inStream next.
+ 1 to:(b+1) do:[:i |
+ bits at:index put:c.
+ index := index + 1
+ ]
+ ]
+ ].
+ a _ inStream next
+ ].
+ 1 to: imageWords do: [:i | form bitsWordAt: i put: (bits wordAt: i)]
].
photometric := #whiteIs0.
samplesPerPixel := 1.
@@ -208,30 +214,30 @@
inStream isNil ifTrue:[^ nil].
(inStream skipThroughAll:'idth') isNil ifTrue: [
- 'Not a Sun Raster/Icon File' errorPrintNewline.
- inStream close.
- ^nil
+ 'Not a Sun Raster/Icon File' errorPrintNewline.
+ inStream close.
+ ^nil
].
inStream next; skipSeparators. "skip $="
width := Integer readFrom: inStream.
(width isNil or:[width <= 0]) ifTrue: [
- 'format error (expected number)' errorPrintNewline.
- inStream close.
- ^ nil
+ 'format error (expected number)' errorPrintNewline.
+ inStream close.
+ ^ nil
].
w := width.
(inStream skipThroughAll:'eight') isNil ifTrue: [
- 'format error (expected height)' errorPrintNewline.
- inStream close.
- ^ nil
+ 'format error (expected height)' errorPrintNewline.
+ inStream close.
+ ^ nil
].
inStream next; skipSeparators. "skip $="
height := Integer readFrom: inStream.
(height isNil or:[height <= 0]) ifTrue: [
- 'format error (expected number)' errorPrintNewline.
- inStream close.
- ^nil
+ 'format error (expected number)' errorPrintNewline.
+ inStream close.
+ ^nil
].
h := height.
@@ -242,18 +248,18 @@
index := 0.
1 to:h do: [:row |
- 1 to: (w + 15 // 16) do: [:col |
- "rows are rounded up to next multiple of 16 bits"
- (inStream skipThroughAll:'0x') isNil ifTrue: [^ nil].
- word := Integer readFrom:inStream radix:16.
- word isNil ifTrue:[
- 'format error' errorPrintNewline.
- inStream close.
- ^ nil
- ].
- data at: (index _ index + 1) put: (word bitShift:-8).
- data at: (index _ index + 1) put: (word bitAnd:16rFF).
- ]
+ 1 to: (w + 15 // 16) do: [:col |
+ "rows are rounded up to next multiple of 16 bits"
+ (inStream skipThroughAll:'0x') isNil ifTrue: [^ nil].
+ word := Integer readFrom:inStream radix:16.
+ word isNil ifTrue:[
+ 'format error' errorPrintNewline.
+ inStream close.
+ ^ nil
+ ].
+ data at: (index _ index + 1) put: (word bitShift:-8).
+ data at: (index _ index + 1) put: (word bitAnd:16rFF).
+ ]
].
inStream close.
! !
--- a/TIFFRdr.st Mon Oct 10 03:32:51 1994 +0100
+++ b/TIFFRdr.st Mon Oct 10 03:34:22 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1991 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -11,23 +11,23 @@
"
ImageReader subclass:#TIFFReader
- instanceVariableNames:'planarConfiguration
- subFileType stripOffsets rowsPerStrip
- fillOrder compression group3options predictor
- stripByteCounts
- currentOffset
- stripOffsetsPos stripByteCountsPos bitsPerSamplePos
- colorMapPos'
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:'planarConfiguration
+ subFileType stripOffsets rowsPerStrip
+ fillOrder compression group3options predictor
+ stripByteCounts
+ currentOffset
+ stripOffsetsPos stripByteCountsPos bitsPerSamplePos
+ colorMapPos'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
TIFFReader comment:'
COPYRIGHT (c) 1991 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libview2/Attic/TIFFRdr.st,v 1.10 1994-08-22 13:15:34 claus Exp $
+$Header: /cvs/stx/stx/libview2/Attic/TIFFRdr.st,v 1.11 1994-10-10 02:33:22 claus Exp $
'!
!TIFFReader class methodsFor:'documentation'!
@@ -35,7 +35,7 @@
copyright
"
COPYRIGHT (c) 1991 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -48,7 +48,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/Attic/TIFFRdr.st,v 1.10 1994-08-22 13:15:34 claus Exp $
+$Header: /cvs/stx/stx/libview2/Attic/TIFFRdr.st,v 1.11 1994-10-10 02:33:22 claus Exp $
"
!
@@ -71,6 +71,14 @@
"
! !
+!TIFFReader class methodsFor:'initialization'!
+
+initialize
+ Image fileFormats at:'.tiff' put:self.
+ Image fileFormats at:'.tif' put:self.
+ Image fileFormats at:'.TIF' put:self.
+! !
+
!TIFFReader class methodsFor:'testing'!
isValidImageFile:aFileName
@@ -85,8 +93,8 @@
char2 := inStream next.
((char1 ~~ char2) or:[(char1 ~~ $I) and:[char1 ~~ $M]]) ifTrue:[
- inStream close.
- ^ false
+ inStream close.
+ ^ false
].
inStream binary.
@@ -115,29 +123,29 @@
char1 := inStream next.
char2 := inStream next.
(char1 ~~ char2) ifTrue:[
- 'TIFFReader: not a tiff file' errorPrintNL.
- inStream close.
- ^ nil
+ 'TIFFReader: not a tiff file' errorPrintNL.
+ inStream close.
+ ^ nil
].
(char1 == $I) ifTrue:[
- byteOrder := #lsb
+ byteOrder := #lsb
] ifFalse:[
- (char1 == $M) ifTrue:[
- byteOrder := #msb
- ] ifFalse:[
- 'TIFFReader: not a tiff file' errorPrintNL.
- inStream close.
- ^ nil
- ]
+ (char1 == $M) ifTrue:[
+ byteOrder := #msb
+ ] ifFalse:[
+ 'TIFFReader: not a tiff file' errorPrintNL.
+ inStream close.
+ ^ nil
+ ]
].
inStream binary.
version := self readShort.
(version ~~ 42) ifTrue:[
- 'TIFFReader: version of tiff-file not supported' errorPrintNL.
- inStream close.
- ^ nil
+ 'TIFFReader: version of tiff-file not supported' errorPrintNL.
+ inStream close.
+ ^ nil
].
"setup default values"
@@ -160,79 +168,79 @@
numberOfTags := self readShort.
1 to:numberOfTags do:[:index |
- tagType := self readShort.
- numberType := self readShort.
- length := self readLong.
- self decodeTiffTag:tagType numberType:numberType length:length
+ tagType := self readShort.
+ numberType := self readShort.
+ length := self readLong.
+ self decodeTiffTag:tagType numberType:numberType length:length
].
offset := self readLong.
(offset ~~ 0) ifTrue:[
- 'TIFFReader: more tags ignored' errorPrintNL
+ 'TIFFReader: more tags ignored' errorPrintNL
].
"check for required tags"
ok := true.
width isNil ifTrue:[
- 'TIFFReader: missing width tag' errorPrintNL.
- ok := false
+ 'TIFFReader: missing width tag' errorPrintNL.
+ ok := false
].
height isNil ifTrue:[
- 'TIFFReader: missing length tag' errorPrintNL.
- ok := false
+ 'TIFFReader: missing length tag' errorPrintNL.
+ ok := false
].
photometric isNil ifTrue:[
- 'TIFFReader: missing photometric tag' errorPrintNL.
- ok := false
+ 'TIFFReader: missing photometric tag' errorPrintNL.
+ ok := false
].
stripOffsets isNil ifTrue:[
- 'TIFFReader: missing stripOffsets tag' errorPrintNL.
- ok := false
+ 'TIFFReader: missing stripOffsets tag' errorPrintNL.
+ ok := false
].
ok ifFalse:[
- inStream close.
- ^ nil
+ inStream close.
+ ^ nil
].
"given all the information, read the bits"
rowsPerStrip isNil ifTrue:[
- rowsPerStrip := height
+ rowsPerStrip := height
].
(compression == 1) ifTrue:[
result := self readUncompressedTiffImageData
] ifFalse:[
(compression == 5) ifTrue:[
- result := self readLZWTiffImageData
+ result := self readLZWTiffImageData
] ifFalse:[
- (compression == 2) ifTrue:[
- "result := self readCCITT3ModHuffmanTiffImageData"
- 'TIFFReader: ccitt mod Huffman compression not implemented' errorPrintNL
- ] ifFalse:[
- (compression == 3) ifTrue:[
- result := self readCCITTGroup3TiffImageData
- ] ifFalse:[
- (compression == 4) ifTrue:[
- "result := self readCCITTGroup4TiffImageData"
- 'TIFFReader: ccitt group4 fax compression not implemented' errorPrintNL
- ] ifFalse:[
- (compression == 32773) ifTrue:[
- result := self readPackbitsTiffImageData
- ] ifFalse:[
- (compression == 32865) ifTrue:[
- result := self readJPEGTiffImageData
- ] ifFalse:[
- 'TIFFReader: compression type ' , compression printString , ' not known' errorPrintNL
- ]
- ]
- ]
- ]
- ]
+ (compression == 2) ifTrue:[
+ "result := self readCCITT3ModHuffmanTiffImageData"
+ 'TIFFReader: ccitt mod Huffman compression not implemented' errorPrintNL
+ ] ifFalse:[
+ (compression == 3) ifTrue:[
+ result := self readCCITTGroup3TiffImageData
+ ] ifFalse:[
+ (compression == 4) ifTrue:[
+ "result := self readCCITTGroup4TiffImageData"
+ 'TIFFReader: ccitt group4 fax compression not implemented' errorPrintNL
+ ] ifFalse:[
+ (compression == 32773) ifTrue:[
+ result := self readPackbitsTiffImageData
+ ] ifFalse:[
+ (compression == 32865) ifTrue:[
+ result := self readJPEGTiffImageData
+ ] ifFalse:[
+ 'TIFFReader: compression type ' , compression printString , ' not known' errorPrintNL
+ ]
+ ]
+ ]
+ ]
+ ]
]
].
@@ -249,8 +257,8 @@
outStream := FileStream newFileNamed:aFileName.
outStream isNil ifTrue:[
- 'TIFFReader: create error' errorPrintNL.
- ^ nil
+ 'TIFFReader: create error' errorPrintNL.
+ ^ nil
].
"save as msb"
@@ -274,11 +282,11 @@
currentOffset := 0.
(byteOrder == #msb) ifTrue:[
- outStream nextPut:$M.
- outStream nextPut:$M.
+ outStream nextPut:$M.
+ outStream nextPut:$M.
] ifFalse:[
- outStream nextPut:$I.
- outStream nextPut:$I.
+ outStream nextPut:$I.
+ outStream nextPut:$I.
].
currentOffset := currentOffset + 2.
@@ -298,7 +306,7 @@
self writeStripByteCounts. "this outputs strip bytecounts, sets stripByteCountPos"
self writeBitsPerSample. "this outputs bitsPerSample, sets bitsPerSamplePos"
photometric == #palette ifTrue:[
- self writeColorMap "this outputs colorMap, sets colorMapPos"
+ self writeColorMap "this outputs colorMap, sets colorMapPos"
].
pos := outStream position. "backpatch tag offset"
@@ -307,14 +315,14 @@
outStream position:pos.
"
('patch tag offset at: ', (pos1 printStringRadix:16) , ' to ',
- (pos printStringRadix:16)) printNewline.
+ (pos printStringRadix:16)) printNewline.
"
"output tag data"
photometric == #palette ifTrue:[
- self writeShort:10. "10 tags"
+ self writeShort:10. "10 tags"
] ifFalse:[
- self writeShort:9. "9 tags"
+ self writeShort:9. "9 tags"
].
self writeTag:256. "image width"
self writeTag:257. "image height"
@@ -322,11 +330,11 @@
self writeTag:259. "compression"
self writeTag:262. "photometric"
self writeTag:273. "strip offsets"
+ self writeTag:278. "rowsPerStrip"
self writeTag:279. "strip byte counts"
self writeTag:284. "planarconfig"
- self writeTag:278. "rowsPerStrip"
photometric == #palette ifTrue:[
- self writeTag:320 "colorMap"
+ self writeTag:320 "colorMap"
].
self writeLong:0. "end of tags mark"
outStream close
@@ -339,22 +347,22 @@
values := Array new:n.
(n == 1) ifTrue:[
- values at:1 put:self readLong.
+ values at:1 put:self readLong.
] ifFalse:[
- offset := self readLong.
- oldPos := inStream position.
- inStream position:(offset + 1).
- 1 to:n do:[:index |
- values at:index put:self readLong
- ].
- inStream position:oldPos
+ offset := self readLong.
+ oldPos := inStream position.
+ inStream position:(offset + 1).
+ 1 to:n do:[:index |
+ values at:index put:self readLong
+ ].
+ inStream position:oldPos
].
^ values
!
writeLongs:longs
1 to:longs size do:[:l |
- self writeLong:l
+ self writeLong:l
]
!
@@ -363,20 +371,20 @@
values := Array new:n.
(n <= 2) ifTrue:[
- values at:1 put:self readShort.
- (n == 2) ifTrue:[
- values at:2 put:self readShort
- ] ifFalse:[
- self readShort
- ]
+ values at:1 put:self readShort.
+ (n == 2) ifTrue:[
+ values at:2 put:self readShort
+ ] ifFalse:[
+ self readShort
+ ]
] ifFalse:[
- offset := self readLong.
- oldPos := inStream position.
- inStream position:(offset + 1).
- 1 to:n do:[:index |
- values at:index put:self readShort
- ].
- inStream position:oldPos
+ offset := self readLong.
+ oldPos := inStream position.
+ inStream position:(offset + 1).
+ 1 to:n do:[:index |
+ values at:index put:self readShort
+ ].
+ inStream position:oldPos
].
^ values
!
@@ -386,13 +394,13 @@
string := String new:(n - 1).
(n <= 4) ifTrue:[
- inStream nextBytes:(n - 1) into:string
+ inStream nextBytes:(n - 1) into:string
] ifFalse:[
- offset := self readLong.
- oldPos := inStream position.
- inStream position:(offset + 1).
- inStream nextBytes:(n - 1) into:string.
- inStream position:oldPos
+ offset := self readLong.
+ oldPos := inStream position.
+ inStream position:(offset + 1).
+ inStream nextBytes:(n - 1) into:string.
+ inStream position:oldPos
].
^ string
!
@@ -405,9 +413,9 @@
oldPos := inStream position.
inStream position:(offset + 1).
1 to:cnt do:[:index |
- n := self readLong.
- d := self readLong.
- values at:index put:(Fraction numerator:n denominator:d)
+ n := self readLong.
+ d := self readLong.
+ values at:index put:(Fraction numerator:n denominator:d)
].
inStream position:oldPos.
^ values
@@ -415,413 +423,416 @@
decodeTiffTag:tagType numberType:numberType length:length
|offset value valueArray
- val
+ val map scaleFactor
n "{ Class: SmallInteger }" |
(numberType == 3) ifTrue:[
- "short"
- valueArray := self readShorts:length.
- value := valueArray at:1
+ "short"
+ valueArray := self readShorts:length.
+ value := valueArray at:1
] ifFalse:[
- (numberType == 4) ifTrue:[
- "integer"
- valueArray := self readLongs:length.
- value := valueArray at:1
- ] ifFalse:[
- (numberType == 2) ifTrue:[
- "character"
- value := self readChars:length
- ] ifFalse:[
- (numberType == 5) ifTrue:[
- "fraction"
- valueArray := self readFracts:length.
- value := valueArray at:1
- ] ifFalse:[
- offset := self readLong
- ]
- ]
- ]
+ (numberType == 4) ifTrue:[
+ "integer"
+ valueArray := self readLongs:length.
+ value := valueArray at:1
+ ] ifFalse:[
+ (numberType == 2) ifTrue:[
+ "character"
+ value := self readChars:length
+ ] ifFalse:[
+ (numberType == 5) ifTrue:[
+ "fraction"
+ valueArray := self readFracts:length.
+ value := valueArray at:1
+ ] ifFalse:[
+ offset := self readLong
+ ]
+ ]
+ ]
].
(tagType == 254) ifTrue:[
- "NewSubfileType"
- "newSubFileType := value."
+ "NewSubfileType"
+ "newSubFileType := value."
"
- 'newSubfiletype ' print. value printNewline.
+ 'newSubfiletype ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 255) ifTrue:[
- "SubfileType"
- subFileType := value.
+ "SubfileType"
+ subFileType := value.
"
- 'subfiletype ' print. value printNewline.
+ 'subfiletype ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 256) ifTrue:[
- "ImageWidth"
- width := value.
+ "ImageWidth"
+ width := value.
"
- 'width ' print. width printNewline.
+ 'width ' print. width printNewline.
"
- ^ self
+ ^ self
].
(tagType == 257) ifTrue:[
- "ImageHeight"
- height := value.
+ "ImageHeight"
+ height := value.
"
- 'height ' print. height printNewline.
+ 'height ' print. height printNewline.
"
- ^ self
+ ^ self
].
(tagType == 258) ifTrue:[
- "bitspersample"
- bitsPerSample := valueArray.
+ "bitspersample"
+ bitsPerSample := valueArray.
"
- 'bitspersample ' print. bitsPerSample printNewline.
+ 'bitspersample ' print. bitsPerSample printNewline.
"
- ^ self
+ ^ self
].
(tagType == 259) ifTrue:[
- "compression"
- compression := value.
+ "compression"
+ compression := value.
"
- 'compression ' print. compression printNewline.
+ 'compression ' print. compression printNewline.
"
- ^ self
+ ^ self
].
(tagType == 262) ifTrue:[
- "photometric"
- (value == 0) ifTrue:[
- photometric := #whiteIs0
- ] ifFalse:[
- (value == 1) ifTrue:[
- photometric := #blackIs0
- ] ifFalse:[
- (value == 2) ifTrue:[
- photometric := #rgb
- ] ifFalse:[
- (value == 3) ifTrue:[
- photometric := #palette
- ] ifFalse:[
- (value == 4) ifTrue:[
- photometric := #transparency
- ] ifFalse:[
- photometric := nil
- ]
- ]
- ]
- ]
- ].
+ "photometric"
+ (value == 0) ifTrue:[
+ photometric := #whiteIs0
+ ] ifFalse:[
+ (value == 1) ifTrue:[
+ photometric := #blackIs0
+ ] ifFalse:[
+ (value == 2) ifTrue:[
+ photometric := #rgb
+ ] ifFalse:[
+ (value == 3) ifTrue:[
+ photometric := #palette
+ ] ifFalse:[
+ (value == 4) ifTrue:[
+ photometric := #transparency
+ ] ifFalse:[
+ photometric := nil
+ ]
+ ]
+ ]
+ ]
+ ].
"
- 'photometric ' print. photometric printNewline.
+ 'photometric ' print. photometric printNewline.
"
- ^ self
+ ^ self
].
(tagType == 263) ifTrue:[
- "Treshholding"
- "threshholding := value."
+ "Treshholding"
+ "threshholding := value."
"
- 'treshholding ' print. value printNewline.
+ 'treshholding ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 264) ifTrue:[
- "CellWidth"
- "cellWidth:= value."
+ "CellWidth"
+ "cellWidth:= value."
"
- 'cellWidth ' print. value printNewline.
+ 'cellWidth ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 265) ifTrue:[
- "CellLength"
- "cellLength:= value."
+ "CellLength"
+ "cellLength:= value."
"
- 'cellLength ' print. value printNewline.
+ 'cellLength ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 266) ifTrue:[
- "fillOrder"
- (value == 1) ifTrue:[
- fillOrder := #msb
- ] ifFalse:[
- (value == 2) ifTrue:[
- fillOrder := #lsb
- ] ifFalse:[
- fillOrder := nil
- ]
- ].
+ "fillOrder"
+ (value == 1) ifTrue:[
+ fillOrder := #msb
+ ] ifFalse:[
+ (value == 2) ifTrue:[
+ fillOrder := #lsb
+ ] ifFalse:[
+ fillOrder := nil
+ ]
+ ].
"
- 'fillorder ' print. fillOrder printNewline.
+ 'fillorder ' print. fillOrder printNewline.
"
- ^ self
+ ^ self
].
(tagType == 269) ifTrue:[
- "documentName"
+ "documentName"
"
- 'documentName ' print. value printNewline.
+ 'documentName ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 270) ifTrue:[
- "imageDescription"
+ "imageDescription"
"
- 'imageDescription ' print. value printNewline.
+ 'imageDescription ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 271) ifTrue:[
- "make"
+ "make"
"
- 'make ' print. value printNewline.
+ 'make ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 272) ifTrue:[
- "model"
+ "model"
"
- 'model ' print. value printNewline.
+ 'model ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 273) ifTrue:[
- "stripoffsets"
- stripOffsets := valueArray.
+ "stripoffsets"
+ stripOffsets := valueArray.
"
- 'stripOffsets Array(' print. stripOffsets size print. ')' printNewline.
+ 'stripOffsets Array(' print. stripOffsets size print. ')' printNewline.
"
- ^ self
+ ^ self
].
(tagType == 274) ifTrue:[
- "Orientation"
- "orientation:= value."
+ "Orientation"
+ "orientation:= value."
"
- 'orientation ' print. value printNewline.
+ 'orientation ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 277) ifTrue:[
- "samplesPerPixel"
- samplesPerPixel := value.
+ "samplesPerPixel"
+ samplesPerPixel := value.
"
- 'samplesperpixel ' print. samplesPerPixel printNewline.
+ 'samplesperpixel ' print. samplesPerPixel printNewline.
"
- ^ self
+ ^ self
].
(tagType == 278) ifTrue:[
- "rowsperstrip"
- rowsPerStrip := value.
+ "rowsperstrip"
+ rowsPerStrip := value.
"
- 'rowsperstrip ' print. rowsPerStrip printNewline.
+ 'rowsperstrip ' print. rowsPerStrip printNewline.
"
- ^ self
+ ^ self
].
(tagType == 279) ifTrue:[
- "stripbytecount"
- stripByteCounts := valueArray.
+ "stripbytecount"
+ stripByteCounts := valueArray.
"
- 'stripByteCounts Array(' print.
- stripByteCounts size print.
- ')' printNewline.
+ 'stripByteCounts Array(' print.
+ stripByteCounts size print.
+ ')' printNewline.
"
- ^ self
+ ^ self
].
(tagType == 280) ifTrue:[
- "MinSampleValue"
- "minSampleValue:= value."
+ "MinSampleValue"
+ "minSampleValue:= value."
"
- 'minSampleValue ' print. value printNewline.
+ 'minSampleValue ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 281) ifTrue:[
- "MaxSampleValue"
- "maxSampleValue:= value."
+ "MaxSampleValue"
+ "maxSampleValue:= value."
"
- 'maxSampleValue ' print. value printNewline.
+ 'maxSampleValue ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 282) ifTrue:[
- "xResolution"
+ "xResolution"
"
- 'xres ' print. value printNewline.
+ 'xres ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 283) ifTrue:[
- "yResolution"
+ "yResolution"
"
- 'yres ' print. value printNewline.
+ 'yres ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 284) ifTrue:[
- "planarconfig"
- (value == 1) ifTrue:[
- planarConfiguration := 1
- ] ifFalse:[
- (value == 2) ifTrue:[
- planarConfiguration := 2
- ] ifFalse:[
- planarConfiguration := nil
- ]
- ].
+ "planarconfig"
+ (value == 1) ifTrue:[
+ planarConfiguration := 1
+ ] ifFalse:[
+ (value == 2) ifTrue:[
+ planarConfiguration := 2
+ ] ifFalse:[
+ planarConfiguration := nil
+ ]
+ ].
"
- 'planarconfig ' print. planarConfiguration printNewline.
+ 'planarconfig ' print. planarConfiguration printNewline.
"
- ^ self
+ ^ self
].
(tagType == 285) ifTrue:[
- "pageName"
+ "pageName"
"
- 'pageName ' print. value printNewline.
+ 'pageName ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 286) ifTrue:[
- "xPosition"
+ "xPosition"
"
- 'xPos ' print. value printNewline.
+ 'xPos ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 287) ifTrue:[
- "yPosition"
+ "yPosition"
"
- 'yPos ' print. value printNewline.
+ 'yPos ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 288) ifTrue:[
- "freeOffsets"
+ "freeOffsets"
"
- 'freeOffsets ' print. value printNewline.
+ 'freeOffsets ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 289) ifTrue:[
- "freeByteCounts"
+ "freeByteCounts"
"
- 'freeByteCounts ' print. value printNewline.
+ 'freeByteCounts ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 290) ifTrue:[
- "grayResponceUnit"
+ "grayResponceUnit"
"
- 'grayResponceUnit' print. value printNewline.
+ 'grayResponceUnit' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 291) ifTrue:[
- "grayResponceCurve"
+ "grayResponceCurve"
"
- 'grayResponceCurve' print. value printNewline.
+ 'grayResponceCurve' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 292) ifTrue:[
- "group3options"
- group3options := value.
+ "group3options"
+ group3options := value.
"
- 'group3options ' print. group3options printNewline.
+ 'group3options ' print. group3options printNewline.
"
- ^ self
+ ^ self
].
(tagType == 293) ifTrue:[
- "group4options"
- "group4options := value."
+ "group4options"
+ "group4options := value."
"
- 'group4options ' print. value printNewline.
+ 'group4options ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 296) ifTrue:[
- "resolutionunit"
+ "resolutionunit"
"
- (value == 1) ifTrue:[
- 'res-unit pixel' printNewline
- ] ifFalse:[
- (value == 2) ifTrue:[
- 'res-unit inch' printNewline
- ] ifFalse:[
- (value == 3) ifTrue:[
- 'res-unit mm' printNewline
- ] ifFalse:[
- 'res-unit invalid' printNewline
- ]
- ]
- ].
+ (value == 1) ifTrue:[
+ 'res-unit pixel' printNewline
+ ] ifFalse:[
+ (value == 2) ifTrue:[
+ 'res-unit inch' printNewline
+ ] ifFalse:[
+ (value == 3) ifTrue:[
+ 'res-unit mm' printNewline
+ ] ifFalse:[
+ 'res-unit invalid' printNewline
+ ]
+ ]
+ ].
"
- "resolutionUnit := value."
- ^ self
+ "resolutionUnit := value."
+ ^ self
].
(tagType == 297) ifTrue:[
- "pageNumber"
- "pageNumber := value."
+ "pageNumber"
+ "pageNumber := value."
"
- 'pageNumber ' print. value printNewline.
+ 'pageNumber ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 300) ifTrue:[
- "colorResponceUnit"
+ "colorResponceUnit"
"
- 'colorResponceUnit' print. value printNewline.
+ 'colorResponceUnit' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 301) ifTrue:[
- "colorResponceCurve"
+ "colorResponceCurve"
"
- 'colorResponceCurve' print. value printNewline.
+ 'colorResponceCurve' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 306) ifTrue:[
- "dateTime"
+ "dateTime"
"
- 'dateTime ' print. value printNewline.
+ 'dateTime ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 315) ifTrue:[
- "artist"
+ "artist"
"
- 'artist ' print. value printNewline.
+ 'artist ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 317) ifTrue:[
- "predictor"
- predictor := value.
+ "predictor"
+ predictor := value.
"
- 'predictor ' print. predictor printNewline.
+ 'predictor ' print. predictor printNewline.
"
- ^ self
+ ^ self
].
(tagType == 320) ifTrue:[
- "colorMap"
+ "colorMap"
"
- 'colorMap (size=' print. valueArray size print. ')' printNewline.
+ 'colorMap (size=' print. valueArray size print. ')' printNewline.
"
- n := valueArray size // 3.
- colorMap := Array new:3.
- colorMap at:1 put:(valueArray copyFrom:1 to:n).
- colorMap at:2 put:(valueArray copyFrom:n+1 to:2*n).
- colorMap at:3 put:(valueArray copyFrom:2*n+1 to:3*n).
- 1 to:3 do:[:c |
- 1 to:n do:[:e |
- val := (colorMap at:c) at:e.
- val := (val * 255.0 / 16rFFFF) rounded.
- (colorMap at:c) at:e put:val
- ]
- ].
- ^ self
+ n := valueArray size // 3.
+ colorMap := Array new:3.
+ colorMap at:1 put:(valueArray copyFrom:1 to:n).
+ colorMap at:2 put:(valueArray copyFrom:n+1 to:2*n).
+ colorMap at:3 put:(valueArray copyFrom:2*n+1 to:3*n).
+
+ scaleFactor := 255.0 / 16rFFFF.
+ 1 to:3 do:[:c |
+ map := colorMap at:c.
+ 1 to:n do:[:e |
+ val := map at:e.
+ val := (val * scaleFactor) rounded.
+ map at:e put:val
+ ]
+ ].
+ ^ self
].
"
@@ -839,22 +850,22 @@
nBytes := data size.
nBytes < 16rFFFF ifTrue:[
- stripOffsets := Array with:(outStream position - 1).
- stripByteCounts := Array with:nBytes.
- outStream nextPutBytes:nBytes from:data.
- rowsPerStrip := height
+ stripOffsets := Array with:(outStream position - 1).
+ stripByteCounts := Array with:nBytes.
+ outStream nextPutBytes:nBytes from:data.
+ rowsPerStrip := height
] ifFalse:[
- stripOffsets := Array new:height.
- bytesPerRow := nBytes // height.
- stripByteCounts := Array new:height withAll:bytesPerRow.
+ stripOffsets := Array new:height.
+ bytesPerRow := nBytes // height.
+ stripByteCounts := Array new:height withAll:bytesPerRow.
- offs := 1.
- 1 to:height do:[:row |
- stripOffsets at:row put:(outStream position - 1).
- outStream nextPutBytes:bytesPerRow from:data startingAt:offs.
- offs := offs + bytesPerRow
- ].
- rowsPerStrip := 1
+ offs := 1.
+ 1 to:height do:[:row |
+ stripOffsets at:row put:(outStream position - 1).
+ outStream nextPutBytes:bytesPerRow from:data startingAt:offs.
+ offs := offs + bytesPerRow
+ ].
+ rowsPerStrip := 1
].
"
'stripOffsets: ' print. stripOffsets printNewline.
@@ -863,17 +874,28 @@
!
writeColorMap
+ |n|
+
colorMapPos := outStream position.
colorMap do:[:subMap |
- subMap do:[:entry |
- "my maps are 8 bit - tiff map is 16 bit"
- entry isNil ifTrue:[
- "unused map entry"
- self writeShort:0
- ] ifFalse:[
- self writeShort:(entry / 255 * 16rFFFF) rounded
- ]
- ]
+ n := 0.
+ subMap do:[:entry |
+ "my maps are 8 bit - tiff map is 16 bit"
+ entry isNil ifTrue:[
+ "unused map entry"
+ self writeShort:0
+ ] ifFalse:[
+ self writeShort:(entry / 255 * 16rFFFF) rounded
+ ].
+ n := n + 1
+ ].
+ "
+ fill to 256 entries
+ "
+ [n < 256] whileTrue:[
+ self writeShort:0.
+ n := n + 1.
+ ]
]
!
@@ -884,7 +906,7 @@
"
stripOffsetsPos := outStream position.
stripOffsets do:[:o |
- self writeLong:o
+ self writeLong:o
]
!
@@ -895,7 +917,7 @@
"
stripByteCountsPos := outStream position.
stripByteCounts do:[:c |
- self writeShort:c
+ self writeShort:c
]
!
@@ -906,7 +928,7 @@
"
bitsPerSamplePos := outStream position.
bitsPerSample do:[:n |
- self writeShort:n
+ self writeShort:n
]
!
@@ -920,61 +942,61 @@
count := 1.
address := nil.
(tagType == 253) ifTrue:[
- "tiff class"
+ "tiff class"
].
(tagType == 254) ifTrue:[
].
(tagType == 255) ifTrue:[
- "SubfileType"
- value := subFileType.
- numberType := #long.
+ "SubfileType"
+ value := subFileType.
+ numberType := #long.
].
(tagType == 256) ifTrue:[
- "ImageWidth"
- value := width.
- numberType := #short.
+ "ImageWidth"
+ value := width.
+ numberType := #short.
].
(tagType == 257) ifTrue:[
- "ImageHeight"
- value := height.
- numberType := #short.
+ "ImageHeight"
+ value := height.
+ numberType := #short.
].
(tagType == 258) ifTrue:[
- "bitspersample"
- address := bitsPerSamplePos - 1.
- numberType := #short.
- count := bitsPerSample size.
- valueArray := bitsPerSample
+ "bitspersample"
+ address := bitsPerSamplePos - 1.
+ numberType := #short.
+ count := bitsPerSample size.
+ valueArray := bitsPerSample
].
(tagType == 259) ifTrue:[
- "compression"
- value := compression.
- numberType := #short.
+ "compression"
+ value := compression.
+ numberType := #short.
].
(tagType == 262) ifTrue:[
- "photometric"
- (photometric == #whiteIs0) ifTrue:[
- value := 0
- ] ifFalse:[
- (photometric == #blackIs0) ifTrue:[
- value := 1
- ] ifFalse:[
- (photometric == #rgb) ifTrue:[
- value := 2
- ] ifFalse:[
- (photometric == #palette) ifTrue:[
- value := 3
- ] ifFalse:[
- (photometric == #transparency) ifTrue:[
- value := 4
- ] ifFalse:[
- self error:'bad photometric'
- ]
- ]
- ]
- ]
- ].
- numberType := #short.
+ "photometric"
+ (photometric == #whiteIs0) ifTrue:[
+ value := 0
+ ] ifFalse:[
+ (photometric == #blackIs0) ifTrue:[
+ value := 1
+ ] ifFalse:[
+ (photometric == #rgb) ifTrue:[
+ value := 2
+ ] ifFalse:[
+ (photometric == #palette) ifTrue:[
+ value := 3
+ ] ifFalse:[
+ (photometric == #transparency) ifTrue:[
+ value := 4
+ ] ifFalse:[
+ self error:'bad photometric'
+ ]
+ ]
+ ]
+ ]
+ ].
+ numberType := #short.
].
(tagType == 263) ifTrue:[
].
@@ -983,17 +1005,17 @@
(tagType == 265) ifTrue:[
].
(tagType == 266) ifTrue:[
- "fillOrder"
- (fillOrder == #msb) ifTrue:[
- value := 1
- ] ifFalse:[
- (fillOrder == #lsb) ifTrue:[
- value := 2
- ] ifFalse:[
- self error:'bad fillOrder'
- ]
- ].
- numberType := #short.
+ "fillOrder"
+ (fillOrder == #msb) ifTrue:[
+ value := 1
+ ] ifFalse:[
+ (fillOrder == #lsb) ifTrue:[
+ value := 2
+ ] ifFalse:[
+ self error:'bad fillOrder'
+ ]
+ ].
+ numberType := #short.
].
(tagType == 269) ifTrue:[
].
@@ -1004,109 +1026,109 @@
(tagType == 272) ifTrue:[
].
(tagType == 273) ifTrue:[
- "stripoffsets"
- address := stripOffsetsPos - 1.
- numberType := #long.
- count := stripOffsets size.
- valueArray := stripOffsets
+ "stripoffsets"
+ address := stripOffsetsPos - 1.
+ numberType := #long.
+ count := stripOffsets size.
+ valueArray := stripOffsets
].
(tagType == 274) ifTrue:[
].
(tagType == 277) ifTrue:[
- "samplesPerPixel"
- value := samplesPerPixel.
- numberType := #short.
+ "samplesPerPixel"
+ value := samplesPerPixel.
+ numberType := #short.
].
(tagType == 278) ifTrue:[
- "rowsperstrip"
- value := rowsPerStrip.
- numberType := #short.
+ "rowsperstrip"
+ value := rowsPerStrip.
+ numberType := #short.
].
(tagType == 279) ifTrue:[
- "stripbytecount"
- address := stripByteCountsPos - 1.
- numberType := #short.
- count := stripByteCounts size.
- valueArray := stripByteCounts
+ "stripbytecount"
+ address := stripByteCountsPos - 1.
+ numberType := #short.
+ count := stripByteCounts size.
+ valueArray := stripByteCounts
].
(tagType == 280) ifTrue:[
- "min sample value"
+ "min sample value"
].
(tagType == 281) ifTrue:[
- "max sample value"
+ "max sample value"
].
(tagType == 282) ifTrue:[
- "x resolution"
+ "x resolution"
].
(tagType == 283) ifTrue:[
- "y resolution"
+ "y resolution"
].
(tagType == 284) ifTrue:[
- "planarconfig"
- value := planarConfiguration.
- numberType := #short.
+ "planarconfig"
+ value := planarConfiguration.
+ numberType := #short.
].
(tagType == 285) ifTrue:[
- "pageName"
+ "pageName"
].
(tagType == 286) ifTrue:[
- "xPosition"
+ "xPosition"
].
(tagType == 287) ifTrue:[
- "yPosition"
+ "yPosition"
].
(tagType == 288) ifTrue:[
- "freeOffsets"
+ "freeOffsets"
].
(tagType == 289) ifTrue:[
- "freeByteCounts"
+ "freeByteCounts"
].
(tagType == 290) ifTrue:[
- "grayResponceUnit"
+ "grayResponceUnit"
].
(tagType == 291) ifTrue:[
- "grayResponceCurve"
+ "grayResponceCurve"
].
(tagType == 292) ifTrue:[
- "group3options"
- value := group3options.
- numberType := #long.
+ "group3options"
+ value := group3options.
+ numberType := #long.
].
(tagType == 293) ifTrue:[
- "group4options"
+ "group4options"
].
(tagType == 296) ifTrue:[
- "resolutionunit"
- ^ self
+ "resolutionunit"
+ ^ self
].
(tagType == 297) ifTrue:[
- "pageNumber"
+ "pageNumber"
].
(tagType == 300) ifTrue:[
- "colorResponceUnit"
+ "colorResponceUnit"
].
(tagType == 301) ifTrue:[
- "colorResponceCurve"
+ "colorResponceCurve"
].
(tagType == 306) ifTrue:[
- "dateTime"
+ "dateTime"
].
(tagType == 315) ifTrue:[
- "artist"
+ "artist"
].
(tagType == 317) ifTrue:[
- "predictor"
+ "predictor"
].
(tagType == 320) ifTrue:[
- "colormap"
- address := colorMapPos - 1.
- numberType := #short.
- count := (colorMap at:1) size * 3.
+ "colormap"
+ address := colorMapPos - 1.
+ numberType := #short.
+ count := 256 "(colorMap at:1) size" * 3.
].
(value isNil and:[address isNil]) ifTrue:[
- self error:'unhandled tag'.
- ^ self
+ self error:'unhandled tag'.
+ ^ self
].
"
@@ -1117,73 +1139,73 @@
self writeShort:tagType.
numberType == #short ifTrue:[
- self writeShort:3.
- self writeLong:count.
+ self writeShort:3.
+ self writeLong:count.
] ifFalse:[
- numberType == #long ifTrue:[
- self writeShort:4.
- self writeLong:count.
- ] ifFalse:[
- numberType == #byte ifTrue:[
- self writeShort:1.
- self writeLong:count.
- ] ifFalse:[
- self error:'bad numbertype'
- ]
- ]
+ numberType == #long ifTrue:[
+ self writeShort:4.
+ self writeLong:count.
+ ] ifFalse:[
+ numberType == #byte ifTrue:[
+ self writeShort:1.
+ self writeLong:count.
+ ] ifFalse:[
+ self error:'bad numbertype'
+ ]
+ ]
].
address notNil ifTrue:[
- (numberType == #long and:[count == 1]) ifTrue:[
- self writeLong:(valueArray at:1).
- ^ self
- ].
- (numberType == #short and:[count <= 2]) ifTrue:[
- self writeShort:(valueArray at:1).
- count == 2 ifTrue:[
- self writeShort:(valueArray at:2).
- ] ifFalse:[
- self writeShort:0
- ].
- ^ self
- ].
- (numberType == #byte and:[count <= 4]) ifTrue:[
- outStream nextPut:(valueArray at:1).
- count > 1 ifTrue:[
- outStream nextPut:(valueArray at:2).
- count > 2 ifTrue:[
- outStream nextPut:(valueArray at:3).
- count > 3 ifTrue:[
- outStream nextPut:(valueArray at:4).
- ] ifFalse:[
- outStream nextPut:0
- ].
- ] ifFalse:[
- outStream nextPut:0
- ].
- ] ifFalse:[
- outStream nextPut:0
- ].
- ^ self
- ].
- self writeLong:address.
- ^ self
+ (numberType == #long and:[count == 1]) ifTrue:[
+ self writeLong:(valueArray at:1).
+ ^ self
+ ].
+ (numberType == #short and:[count <= 2]) ifTrue:[
+ self writeShort:(valueArray at:1).
+ count == 2 ifTrue:[
+ self writeShort:(valueArray at:2).
+ ] ifFalse:[
+ self writeShort:0
+ ].
+ ^ self
+ ].
+ (numberType == #byte and:[count <= 4]) ifTrue:[
+ outStream nextPut:(valueArray at:1).
+ count > 1 ifTrue:[
+ outStream nextPut:(valueArray at:2).
+ count > 2 ifTrue:[
+ outStream nextPut:(valueArray at:3).
+ count > 3 ifTrue:[
+ outStream nextPut:(valueArray at:4).
+ ] ifFalse:[
+ outStream nextPut:0
+ ].
+ ] ifFalse:[
+ outStream nextPut:0
+ ].
+ ] ifFalse:[
+ outStream nextPut:0
+ ].
+ ^ self
+ ].
+ self writeLong:address.
+ ^ self
].
numberType == #short ifTrue:[
- self writeShort:value.
- self writeShort:0
+ self writeShort:value.
+ self writeShort:0
] ifFalse:[
- numberType == #long ifTrue:[
- self writeLong:value
- ] ifFalse:[
- numberType == #byte ifTrue:[
- outStream nextPut:value.
- outStream nextPut:0.
- outStream nextPut:0.
- outStream nextPut:0.
- ] ifFalse:[
- self error:'bad numbertype'
- ]
- ]
+ numberType == #long ifTrue:[
+ self writeLong:value
+ ] ifFalse:[
+ numberType == #byte ifTrue:[
+ outStream nextPut:value.
+ outStream nextPut:0.
+ outStream nextPut:0.
+ outStream nextPut:0.
+ ] ifFalse:[
+ self error:'bad numbertype'
+ ]
+ ]
].
!
@@ -1202,37 +1224,37 @@
or rgb - if non separate planes and no alpha"
(nPlanes == 2) ifTrue:[
- (planarConfiguration ~~ 2) ifTrue:[
- self error:'with alpha, only separate planes supported'.
- ^ nil
- ].
- 'TIFFReader: ignoring alpha plane' errorPrintNL.
- nPlanes := 1.
- bitsPerPixel := bitsPerSample at:1
+ (planarConfiguration ~~ 2) ifTrue:[
+ self error:'with alpha, only separate planes supported'.
+ ^ nil
+ ].
+ 'TIFFReader: ignoring alpha plane' errorPrintNL.
+ nPlanes := 1.
+ bitsPerPixel := bitsPerSample at:1
] ifFalse:[
- (nPlanes == 3) ifTrue:[
- (planarConfiguration ~~ 1) ifTrue:[
- self error:'only non separate planes supported'.
- ^ nil
- ].
- bitsPerSample ~= #(8 8 8) ifTrue:[
- self error:'only 8/8/8 rgb images supported'.
- ^ nil
- ].
- bitsPerPixel := 24
- ] ifFalse:[
- (nPlanes ~~ 1) ifTrue:[
- self error:'format not supported'.
- ^ nil
- ].
- bitsPerPixel := bitsPerSample at:1
- ]
+ (nPlanes == 3) ifTrue:[
+ (planarConfiguration ~~ 1) ifTrue:[
+ self error:'only non separate planes supported'.
+ ^ nil
+ ].
+ bitsPerSample ~= #(8 8 8) ifTrue:[
+ self error:'only 8/8/8 rgb images supported'.
+ ^ nil
+ ].
+ bitsPerPixel := 24
+ ] ifFalse:[
+ (nPlanes ~~ 1) ifTrue:[
+ self error:'format not supported'.
+ ^ nil
+ ].
+ bitsPerPixel := bitsPerSample at:1
+ ]
].
bitsPerRow := width * bitsPerPixel.
bytesPerRow := bitsPerRow // 8.
((bitsPerRow \\ 8) ~~ 0) ifTrue:[
- bytesPerRow := bytesPerRow + 1
+ bytesPerRow := bytesPerRow + 1
].
overAllBytes := bytesPerRow * height.
@@ -1243,13 +1265,13 @@
row := 1.
[row <= height] whileTrue:[
- stripNr := stripNr + 1.
- nBytes := stripByteCounts at:stripNr.
- inStream position:((stripOffsets at:stripNr) + 1).
+ stripNr := stripNr + 1.
+ nBytes := stripByteCounts at:stripNr.
+ inStream position:((stripOffsets at:stripNr) + 1).
- inStream nextBytes:nBytes into:data startingAt:offset.
- offset := offset + nBytes.
- row := row + rowsPerStrip
+ inStream nextBytes:nBytes into:data startingAt:offset.
+ offset := offset + nBytes.
+ row := row + rowsPerStrip
]
!
@@ -1271,38 +1293,38 @@
nPlanes := samplesPerPixel.
(nPlanes == 3) ifTrue:[
- ((bitsPerSample at:1) ~~ 8) ifTrue:[
- self error:'only 8 bit/sample supported'.
- ^ nil
- ].
- ((bitsPerSample at:2) ~~ 8) ifTrue:[
- self error:'only 8 bit/sample supported'.
- ^ nil
- ].
- ((bitsPerSample at:3) ~~ 8) ifTrue:[
- self error:'only 8 bit/sample supported'.
- ^ nil
- ].
- bytesPerRow := width * samplesPerPixel.
+ ((bitsPerSample at:1) ~~ 8) ifTrue:[
+ self error:'only 8 bit/sample supported'.
+ ^ nil
+ ].
+ ((bitsPerSample at:2) ~~ 8) ifTrue:[
+ self error:'only 8 bit/sample supported'.
+ ^ nil
+ ].
+ ((bitsPerSample at:3) ~~ 8) ifTrue:[
+ self error:'only 8 bit/sample supported'.
+ ^ nil
+ ].
+ bytesPerRow := width * samplesPerPixel.
] ifFalse:[
- (nPlanes == 2) ifTrue:[
- (planarConfiguration ~~ 2) ifTrue:[
- self error:'only separate planes supported'.
- ^ nil
- ].
- 'TIFFReader: ignoring alpha plane' errorPrintNL.
- nPlanes := 1
- ].
- (nPlanes == 1) ifFalse:[
- self error:'only 3-sample rgb / monochrome supported'.
- ^ nil
- ].
- bytesPerRow := (width * (bitsPerSample at:1) + 7) // 8.
+ (nPlanes == 2) ifTrue:[
+ (planarConfiguration ~~ 2) ifTrue:[
+ self error:'only separate planes supported'.
+ ^ nil
+ ].
+ 'TIFFReader: ignoring alpha plane' errorPrintNL.
+ nPlanes := 1
+ ].
+ (nPlanes == 1) ifFalse:[
+ self error:'only 3-sample rgb / monochrome supported'.
+ ^ nil
+ ].
+ bytesPerRow := (width * (bitsPerSample at:1) + 7) // 8.
].
stripByteCounts isNil ifTrue:[
- self error:'currently require stripByteCounts'.
- ^ nil
+ self error:'currently require stripByteCounts'.
+ ^ nil
].
'TIFFReader: decompressing LZW ...' errorPrintNL.
@@ -1316,25 +1338,25 @@
bytesPerStrip := bytesPerRow * rowsPerStrip.
prevSize := 0.
[row <= height] whileTrue:[
- stripNr := stripNr + 1.
- inStream position:((stripOffsets at:stripNr) + 1).
- nBytes := stripByteCounts at:stripNr.
- (nBytes > prevSize) ifTrue:[
- compressedStrip := ByteArray uninitializedNew:nBytes.
- prevSize := nBytes
- ].
- inStream nextBytes:nBytes
- into:compressedStrip.
- self class decompressLZWFrom:compressedStrip
- count:nBytes
- into:data
- startingAt:offset.
- offset := offset + bytesPerStrip.
- row := row + rowsPerStrip
+ stripNr := stripNr + 1.
+ inStream position:((stripOffsets at:stripNr) + 1).
+ nBytes := stripByteCounts at:stripNr.
+ (nBytes > prevSize) ifTrue:[
+ compressedStrip := ByteArray uninitializedNew:nBytes.
+ prevSize := nBytes
+ ].
+ inStream nextBytes:nBytes
+ into:compressedStrip.
+ self class decompressLZWFrom:compressedStrip
+ count:nBytes
+ into:data
+ startingAt:offset.
+ offset := offset + bytesPerStrip.
+ row := row + rowsPerStrip
].
(predictor == 2) ifTrue:[
- self class decodeDelta:3 in:data width:width height:height
+ self class decodeDelta:3 in:data width:width height:height
]
!
@@ -1350,22 +1372,22 @@
nPlanes := samplesPerPixel.
(nPlanes == 2) ifTrue:[
- 'TIFFReader: ignoring alpha plane' errorPrintNL.
- nPlanes := 1
+ 'TIFFReader: ignoring alpha plane' errorPrintNL.
+ nPlanes := 1
].
(nPlanes ~~ 1) ifTrue:[
- self error:'only monochrome/greyscale supported'.
- ^ nil
+ self error:'only monochrome/greyscale supported'.
+ ^ nil
].
stripByteCounts isNil ifTrue:[
- self error:'currently require stripByteCounts'.
- ^ nil
+ self error:'currently require stripByteCounts'.
+ ^ nil
].
(rowsPerStrip ~~ 1) isNil ifTrue:[
- self error:'currently require rowsPerStrip to be 1'.
- ^ nil
+ self error:'currently require rowsPerStrip to be 1'.
+ ^ nil
].
'TIFFReader: decompressing CCITT-3 ...' errorPrintNL.
@@ -1373,7 +1395,7 @@
bitsPerRow := width * (bitsPerSample at:1).
bytesPerRow := bitsPerRow // 8.
((bitsPerRow \\ 8) ~~ 0) ifTrue:[
- bytesPerRow := bytesPerRow + 1
+ bytesPerRow := bytesPerRow + 1
].
data := ByteArray new:(bytesPerRow * height).
@@ -1385,15 +1407,15 @@
row := 1.
bytesPerStrip := bytesPerRow * rowsPerStrip.
[row <= height] whileTrue:[
- stripNr := stripNr + 1.
- inStream position:((stripOffsets at:stripNr) + 1).
- inStream nextBytes:(stripByteCounts at:stripNr) into:compressedStrip.
- self class decompressCCITT3From:compressedStrip
- into:data
- startingAt:offset
- count:width.
- offset := offset + bytesPerStrip.
- row := row + rowsPerStrip
+ stripNr := stripNr + 1.
+ inStream position:((stripOffsets at:stripNr) + 1).
+ inStream nextBytes:(stripByteCounts at:stripNr) into:compressedStrip.
+ self class decompressCCITT3From:compressedStrip
+ into:data
+ startingAt:offset
+ count:width.
+ offset := offset + bytesPerStrip.
+ row := row + rowsPerStrip
]
!
--- a/TIFFReader.st Mon Oct 10 03:32:51 1994 +0100
+++ b/TIFFReader.st Mon Oct 10 03:34:22 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1991 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -11,23 +11,23 @@
"
ImageReader subclass:#TIFFReader
- instanceVariableNames:'planarConfiguration
- subFileType stripOffsets rowsPerStrip
- fillOrder compression group3options predictor
- stripByteCounts
- currentOffset
- stripOffsetsPos stripByteCountsPos bitsPerSamplePos
- colorMapPos'
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:'planarConfiguration
+ subFileType stripOffsets rowsPerStrip
+ fillOrder compression group3options predictor
+ stripByteCounts
+ currentOffset
+ stripOffsetsPos stripByteCountsPos bitsPerSamplePos
+ colorMapPos'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
TIFFReader comment:'
COPYRIGHT (c) 1991 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libview2/TIFFReader.st,v 1.10 1994-08-22 13:15:34 claus Exp $
+$Header: /cvs/stx/stx/libview2/TIFFReader.st,v 1.11 1994-10-10 02:33:22 claus Exp $
'!
!TIFFReader class methodsFor:'documentation'!
@@ -35,7 +35,7 @@
copyright
"
COPYRIGHT (c) 1991 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -48,7 +48,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/TIFFReader.st,v 1.10 1994-08-22 13:15:34 claus Exp $
+$Header: /cvs/stx/stx/libview2/TIFFReader.st,v 1.11 1994-10-10 02:33:22 claus Exp $
"
!
@@ -71,6 +71,14 @@
"
! !
+!TIFFReader class methodsFor:'initialization'!
+
+initialize
+ Image fileFormats at:'.tiff' put:self.
+ Image fileFormats at:'.tif' put:self.
+ Image fileFormats at:'.TIF' put:self.
+! !
+
!TIFFReader class methodsFor:'testing'!
isValidImageFile:aFileName
@@ -85,8 +93,8 @@
char2 := inStream next.
((char1 ~~ char2) or:[(char1 ~~ $I) and:[char1 ~~ $M]]) ifTrue:[
- inStream close.
- ^ false
+ inStream close.
+ ^ false
].
inStream binary.
@@ -115,29 +123,29 @@
char1 := inStream next.
char2 := inStream next.
(char1 ~~ char2) ifTrue:[
- 'TIFFReader: not a tiff file' errorPrintNL.
- inStream close.
- ^ nil
+ 'TIFFReader: not a tiff file' errorPrintNL.
+ inStream close.
+ ^ nil
].
(char1 == $I) ifTrue:[
- byteOrder := #lsb
+ byteOrder := #lsb
] ifFalse:[
- (char1 == $M) ifTrue:[
- byteOrder := #msb
- ] ifFalse:[
- 'TIFFReader: not a tiff file' errorPrintNL.
- inStream close.
- ^ nil
- ]
+ (char1 == $M) ifTrue:[
+ byteOrder := #msb
+ ] ifFalse:[
+ 'TIFFReader: not a tiff file' errorPrintNL.
+ inStream close.
+ ^ nil
+ ]
].
inStream binary.
version := self readShort.
(version ~~ 42) ifTrue:[
- 'TIFFReader: version of tiff-file not supported' errorPrintNL.
- inStream close.
- ^ nil
+ 'TIFFReader: version of tiff-file not supported' errorPrintNL.
+ inStream close.
+ ^ nil
].
"setup default values"
@@ -160,79 +168,79 @@
numberOfTags := self readShort.
1 to:numberOfTags do:[:index |
- tagType := self readShort.
- numberType := self readShort.
- length := self readLong.
- self decodeTiffTag:tagType numberType:numberType length:length
+ tagType := self readShort.
+ numberType := self readShort.
+ length := self readLong.
+ self decodeTiffTag:tagType numberType:numberType length:length
].
offset := self readLong.
(offset ~~ 0) ifTrue:[
- 'TIFFReader: more tags ignored' errorPrintNL
+ 'TIFFReader: more tags ignored' errorPrintNL
].
"check for required tags"
ok := true.
width isNil ifTrue:[
- 'TIFFReader: missing width tag' errorPrintNL.
- ok := false
+ 'TIFFReader: missing width tag' errorPrintNL.
+ ok := false
].
height isNil ifTrue:[
- 'TIFFReader: missing length tag' errorPrintNL.
- ok := false
+ 'TIFFReader: missing length tag' errorPrintNL.
+ ok := false
].
photometric isNil ifTrue:[
- 'TIFFReader: missing photometric tag' errorPrintNL.
- ok := false
+ 'TIFFReader: missing photometric tag' errorPrintNL.
+ ok := false
].
stripOffsets isNil ifTrue:[
- 'TIFFReader: missing stripOffsets tag' errorPrintNL.
- ok := false
+ 'TIFFReader: missing stripOffsets tag' errorPrintNL.
+ ok := false
].
ok ifFalse:[
- inStream close.
- ^ nil
+ inStream close.
+ ^ nil
].
"given all the information, read the bits"
rowsPerStrip isNil ifTrue:[
- rowsPerStrip := height
+ rowsPerStrip := height
].
(compression == 1) ifTrue:[
result := self readUncompressedTiffImageData
] ifFalse:[
(compression == 5) ifTrue:[
- result := self readLZWTiffImageData
+ result := self readLZWTiffImageData
] ifFalse:[
- (compression == 2) ifTrue:[
- "result := self readCCITT3ModHuffmanTiffImageData"
- 'TIFFReader: ccitt mod Huffman compression not implemented' errorPrintNL
- ] ifFalse:[
- (compression == 3) ifTrue:[
- result := self readCCITTGroup3TiffImageData
- ] ifFalse:[
- (compression == 4) ifTrue:[
- "result := self readCCITTGroup4TiffImageData"
- 'TIFFReader: ccitt group4 fax compression not implemented' errorPrintNL
- ] ifFalse:[
- (compression == 32773) ifTrue:[
- result := self readPackbitsTiffImageData
- ] ifFalse:[
- (compression == 32865) ifTrue:[
- result := self readJPEGTiffImageData
- ] ifFalse:[
- 'TIFFReader: compression type ' , compression printString , ' not known' errorPrintNL
- ]
- ]
- ]
- ]
- ]
+ (compression == 2) ifTrue:[
+ "result := self readCCITT3ModHuffmanTiffImageData"
+ 'TIFFReader: ccitt mod Huffman compression not implemented' errorPrintNL
+ ] ifFalse:[
+ (compression == 3) ifTrue:[
+ result := self readCCITTGroup3TiffImageData
+ ] ifFalse:[
+ (compression == 4) ifTrue:[
+ "result := self readCCITTGroup4TiffImageData"
+ 'TIFFReader: ccitt group4 fax compression not implemented' errorPrintNL
+ ] ifFalse:[
+ (compression == 32773) ifTrue:[
+ result := self readPackbitsTiffImageData
+ ] ifFalse:[
+ (compression == 32865) ifTrue:[
+ result := self readJPEGTiffImageData
+ ] ifFalse:[
+ 'TIFFReader: compression type ' , compression printString , ' not known' errorPrintNL
+ ]
+ ]
+ ]
+ ]
+ ]
]
].
@@ -249,8 +257,8 @@
outStream := FileStream newFileNamed:aFileName.
outStream isNil ifTrue:[
- 'TIFFReader: create error' errorPrintNL.
- ^ nil
+ 'TIFFReader: create error' errorPrintNL.
+ ^ nil
].
"save as msb"
@@ -274,11 +282,11 @@
currentOffset := 0.
(byteOrder == #msb) ifTrue:[
- outStream nextPut:$M.
- outStream nextPut:$M.
+ outStream nextPut:$M.
+ outStream nextPut:$M.
] ifFalse:[
- outStream nextPut:$I.
- outStream nextPut:$I.
+ outStream nextPut:$I.
+ outStream nextPut:$I.
].
currentOffset := currentOffset + 2.
@@ -298,7 +306,7 @@
self writeStripByteCounts. "this outputs strip bytecounts, sets stripByteCountPos"
self writeBitsPerSample. "this outputs bitsPerSample, sets bitsPerSamplePos"
photometric == #palette ifTrue:[
- self writeColorMap "this outputs colorMap, sets colorMapPos"
+ self writeColorMap "this outputs colorMap, sets colorMapPos"
].
pos := outStream position. "backpatch tag offset"
@@ -307,14 +315,14 @@
outStream position:pos.
"
('patch tag offset at: ', (pos1 printStringRadix:16) , ' to ',
- (pos printStringRadix:16)) printNewline.
+ (pos printStringRadix:16)) printNewline.
"
"output tag data"
photometric == #palette ifTrue:[
- self writeShort:10. "10 tags"
+ self writeShort:10. "10 tags"
] ifFalse:[
- self writeShort:9. "9 tags"
+ self writeShort:9. "9 tags"
].
self writeTag:256. "image width"
self writeTag:257. "image height"
@@ -322,11 +330,11 @@
self writeTag:259. "compression"
self writeTag:262. "photometric"
self writeTag:273. "strip offsets"
+ self writeTag:278. "rowsPerStrip"
self writeTag:279. "strip byte counts"
self writeTag:284. "planarconfig"
- self writeTag:278. "rowsPerStrip"
photometric == #palette ifTrue:[
- self writeTag:320 "colorMap"
+ self writeTag:320 "colorMap"
].
self writeLong:0. "end of tags mark"
outStream close
@@ -339,22 +347,22 @@
values := Array new:n.
(n == 1) ifTrue:[
- values at:1 put:self readLong.
+ values at:1 put:self readLong.
] ifFalse:[
- offset := self readLong.
- oldPos := inStream position.
- inStream position:(offset + 1).
- 1 to:n do:[:index |
- values at:index put:self readLong
- ].
- inStream position:oldPos
+ offset := self readLong.
+ oldPos := inStream position.
+ inStream position:(offset + 1).
+ 1 to:n do:[:index |
+ values at:index put:self readLong
+ ].
+ inStream position:oldPos
].
^ values
!
writeLongs:longs
1 to:longs size do:[:l |
- self writeLong:l
+ self writeLong:l
]
!
@@ -363,20 +371,20 @@
values := Array new:n.
(n <= 2) ifTrue:[
- values at:1 put:self readShort.
- (n == 2) ifTrue:[
- values at:2 put:self readShort
- ] ifFalse:[
- self readShort
- ]
+ values at:1 put:self readShort.
+ (n == 2) ifTrue:[
+ values at:2 put:self readShort
+ ] ifFalse:[
+ self readShort
+ ]
] ifFalse:[
- offset := self readLong.
- oldPos := inStream position.
- inStream position:(offset + 1).
- 1 to:n do:[:index |
- values at:index put:self readShort
- ].
- inStream position:oldPos
+ offset := self readLong.
+ oldPos := inStream position.
+ inStream position:(offset + 1).
+ 1 to:n do:[:index |
+ values at:index put:self readShort
+ ].
+ inStream position:oldPos
].
^ values
!
@@ -386,13 +394,13 @@
string := String new:(n - 1).
(n <= 4) ifTrue:[
- inStream nextBytes:(n - 1) into:string
+ inStream nextBytes:(n - 1) into:string
] ifFalse:[
- offset := self readLong.
- oldPos := inStream position.
- inStream position:(offset + 1).
- inStream nextBytes:(n - 1) into:string.
- inStream position:oldPos
+ offset := self readLong.
+ oldPos := inStream position.
+ inStream position:(offset + 1).
+ inStream nextBytes:(n - 1) into:string.
+ inStream position:oldPos
].
^ string
!
@@ -405,9 +413,9 @@
oldPos := inStream position.
inStream position:(offset + 1).
1 to:cnt do:[:index |
- n := self readLong.
- d := self readLong.
- values at:index put:(Fraction numerator:n denominator:d)
+ n := self readLong.
+ d := self readLong.
+ values at:index put:(Fraction numerator:n denominator:d)
].
inStream position:oldPos.
^ values
@@ -415,413 +423,416 @@
decodeTiffTag:tagType numberType:numberType length:length
|offset value valueArray
- val
+ val map scaleFactor
n "{ Class: SmallInteger }" |
(numberType == 3) ifTrue:[
- "short"
- valueArray := self readShorts:length.
- value := valueArray at:1
+ "short"
+ valueArray := self readShorts:length.
+ value := valueArray at:1
] ifFalse:[
- (numberType == 4) ifTrue:[
- "integer"
- valueArray := self readLongs:length.
- value := valueArray at:1
- ] ifFalse:[
- (numberType == 2) ifTrue:[
- "character"
- value := self readChars:length
- ] ifFalse:[
- (numberType == 5) ifTrue:[
- "fraction"
- valueArray := self readFracts:length.
- value := valueArray at:1
- ] ifFalse:[
- offset := self readLong
- ]
- ]
- ]
+ (numberType == 4) ifTrue:[
+ "integer"
+ valueArray := self readLongs:length.
+ value := valueArray at:1
+ ] ifFalse:[
+ (numberType == 2) ifTrue:[
+ "character"
+ value := self readChars:length
+ ] ifFalse:[
+ (numberType == 5) ifTrue:[
+ "fraction"
+ valueArray := self readFracts:length.
+ value := valueArray at:1
+ ] ifFalse:[
+ offset := self readLong
+ ]
+ ]
+ ]
].
(tagType == 254) ifTrue:[
- "NewSubfileType"
- "newSubFileType := value."
+ "NewSubfileType"
+ "newSubFileType := value."
"
- 'newSubfiletype ' print. value printNewline.
+ 'newSubfiletype ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 255) ifTrue:[
- "SubfileType"
- subFileType := value.
+ "SubfileType"
+ subFileType := value.
"
- 'subfiletype ' print. value printNewline.
+ 'subfiletype ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 256) ifTrue:[
- "ImageWidth"
- width := value.
+ "ImageWidth"
+ width := value.
"
- 'width ' print. width printNewline.
+ 'width ' print. width printNewline.
"
- ^ self
+ ^ self
].
(tagType == 257) ifTrue:[
- "ImageHeight"
- height := value.
+ "ImageHeight"
+ height := value.
"
- 'height ' print. height printNewline.
+ 'height ' print. height printNewline.
"
- ^ self
+ ^ self
].
(tagType == 258) ifTrue:[
- "bitspersample"
- bitsPerSample := valueArray.
+ "bitspersample"
+ bitsPerSample := valueArray.
"
- 'bitspersample ' print. bitsPerSample printNewline.
+ 'bitspersample ' print. bitsPerSample printNewline.
"
- ^ self
+ ^ self
].
(tagType == 259) ifTrue:[
- "compression"
- compression := value.
+ "compression"
+ compression := value.
"
- 'compression ' print. compression printNewline.
+ 'compression ' print. compression printNewline.
"
- ^ self
+ ^ self
].
(tagType == 262) ifTrue:[
- "photometric"
- (value == 0) ifTrue:[
- photometric := #whiteIs0
- ] ifFalse:[
- (value == 1) ifTrue:[
- photometric := #blackIs0
- ] ifFalse:[
- (value == 2) ifTrue:[
- photometric := #rgb
- ] ifFalse:[
- (value == 3) ifTrue:[
- photometric := #palette
- ] ifFalse:[
- (value == 4) ifTrue:[
- photometric := #transparency
- ] ifFalse:[
- photometric := nil
- ]
- ]
- ]
- ]
- ].
+ "photometric"
+ (value == 0) ifTrue:[
+ photometric := #whiteIs0
+ ] ifFalse:[
+ (value == 1) ifTrue:[
+ photometric := #blackIs0
+ ] ifFalse:[
+ (value == 2) ifTrue:[
+ photometric := #rgb
+ ] ifFalse:[
+ (value == 3) ifTrue:[
+ photometric := #palette
+ ] ifFalse:[
+ (value == 4) ifTrue:[
+ photometric := #transparency
+ ] ifFalse:[
+ photometric := nil
+ ]
+ ]
+ ]
+ ]
+ ].
"
- 'photometric ' print. photometric printNewline.
+ 'photometric ' print. photometric printNewline.
"
- ^ self
+ ^ self
].
(tagType == 263) ifTrue:[
- "Treshholding"
- "threshholding := value."
+ "Treshholding"
+ "threshholding := value."
"
- 'treshholding ' print. value printNewline.
+ 'treshholding ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 264) ifTrue:[
- "CellWidth"
- "cellWidth:= value."
+ "CellWidth"
+ "cellWidth:= value."
"
- 'cellWidth ' print. value printNewline.
+ 'cellWidth ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 265) ifTrue:[
- "CellLength"
- "cellLength:= value."
+ "CellLength"
+ "cellLength:= value."
"
- 'cellLength ' print. value printNewline.
+ 'cellLength ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 266) ifTrue:[
- "fillOrder"
- (value == 1) ifTrue:[
- fillOrder := #msb
- ] ifFalse:[
- (value == 2) ifTrue:[
- fillOrder := #lsb
- ] ifFalse:[
- fillOrder := nil
- ]
- ].
+ "fillOrder"
+ (value == 1) ifTrue:[
+ fillOrder := #msb
+ ] ifFalse:[
+ (value == 2) ifTrue:[
+ fillOrder := #lsb
+ ] ifFalse:[
+ fillOrder := nil
+ ]
+ ].
"
- 'fillorder ' print. fillOrder printNewline.
+ 'fillorder ' print. fillOrder printNewline.
"
- ^ self
+ ^ self
].
(tagType == 269) ifTrue:[
- "documentName"
+ "documentName"
"
- 'documentName ' print. value printNewline.
+ 'documentName ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 270) ifTrue:[
- "imageDescription"
+ "imageDescription"
"
- 'imageDescription ' print. value printNewline.
+ 'imageDescription ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 271) ifTrue:[
- "make"
+ "make"
"
- 'make ' print. value printNewline.
+ 'make ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 272) ifTrue:[
- "model"
+ "model"
"
- 'model ' print. value printNewline.
+ 'model ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 273) ifTrue:[
- "stripoffsets"
- stripOffsets := valueArray.
+ "stripoffsets"
+ stripOffsets := valueArray.
"
- 'stripOffsets Array(' print. stripOffsets size print. ')' printNewline.
+ 'stripOffsets Array(' print. stripOffsets size print. ')' printNewline.
"
- ^ self
+ ^ self
].
(tagType == 274) ifTrue:[
- "Orientation"
- "orientation:= value."
+ "Orientation"
+ "orientation:= value."
"
- 'orientation ' print. value printNewline.
+ 'orientation ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 277) ifTrue:[
- "samplesPerPixel"
- samplesPerPixel := value.
+ "samplesPerPixel"
+ samplesPerPixel := value.
"
- 'samplesperpixel ' print. samplesPerPixel printNewline.
+ 'samplesperpixel ' print. samplesPerPixel printNewline.
"
- ^ self
+ ^ self
].
(tagType == 278) ifTrue:[
- "rowsperstrip"
- rowsPerStrip := value.
+ "rowsperstrip"
+ rowsPerStrip := value.
"
- 'rowsperstrip ' print. rowsPerStrip printNewline.
+ 'rowsperstrip ' print. rowsPerStrip printNewline.
"
- ^ self
+ ^ self
].
(tagType == 279) ifTrue:[
- "stripbytecount"
- stripByteCounts := valueArray.
+ "stripbytecount"
+ stripByteCounts := valueArray.
"
- 'stripByteCounts Array(' print.
- stripByteCounts size print.
- ')' printNewline.
+ 'stripByteCounts Array(' print.
+ stripByteCounts size print.
+ ')' printNewline.
"
- ^ self
+ ^ self
].
(tagType == 280) ifTrue:[
- "MinSampleValue"
- "minSampleValue:= value."
+ "MinSampleValue"
+ "minSampleValue:= value."
"
- 'minSampleValue ' print. value printNewline.
+ 'minSampleValue ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 281) ifTrue:[
- "MaxSampleValue"
- "maxSampleValue:= value."
+ "MaxSampleValue"
+ "maxSampleValue:= value."
"
- 'maxSampleValue ' print. value printNewline.
+ 'maxSampleValue ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 282) ifTrue:[
- "xResolution"
+ "xResolution"
"
- 'xres ' print. value printNewline.
+ 'xres ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 283) ifTrue:[
- "yResolution"
+ "yResolution"
"
- 'yres ' print. value printNewline.
+ 'yres ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 284) ifTrue:[
- "planarconfig"
- (value == 1) ifTrue:[
- planarConfiguration := 1
- ] ifFalse:[
- (value == 2) ifTrue:[
- planarConfiguration := 2
- ] ifFalse:[
- planarConfiguration := nil
- ]
- ].
+ "planarconfig"
+ (value == 1) ifTrue:[
+ planarConfiguration := 1
+ ] ifFalse:[
+ (value == 2) ifTrue:[
+ planarConfiguration := 2
+ ] ifFalse:[
+ planarConfiguration := nil
+ ]
+ ].
"
- 'planarconfig ' print. planarConfiguration printNewline.
+ 'planarconfig ' print. planarConfiguration printNewline.
"
- ^ self
+ ^ self
].
(tagType == 285) ifTrue:[
- "pageName"
+ "pageName"
"
- 'pageName ' print. value printNewline.
+ 'pageName ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 286) ifTrue:[
- "xPosition"
+ "xPosition"
"
- 'xPos ' print. value printNewline.
+ 'xPos ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 287) ifTrue:[
- "yPosition"
+ "yPosition"
"
- 'yPos ' print. value printNewline.
+ 'yPos ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 288) ifTrue:[
- "freeOffsets"
+ "freeOffsets"
"
- 'freeOffsets ' print. value printNewline.
+ 'freeOffsets ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 289) ifTrue:[
- "freeByteCounts"
+ "freeByteCounts"
"
- 'freeByteCounts ' print. value printNewline.
+ 'freeByteCounts ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 290) ifTrue:[
- "grayResponceUnit"
+ "grayResponceUnit"
"
- 'grayResponceUnit' print. value printNewline.
+ 'grayResponceUnit' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 291) ifTrue:[
- "grayResponceCurve"
+ "grayResponceCurve"
"
- 'grayResponceCurve' print. value printNewline.
+ 'grayResponceCurve' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 292) ifTrue:[
- "group3options"
- group3options := value.
+ "group3options"
+ group3options := value.
"
- 'group3options ' print. group3options printNewline.
+ 'group3options ' print. group3options printNewline.
"
- ^ self
+ ^ self
].
(tagType == 293) ifTrue:[
- "group4options"
- "group4options := value."
+ "group4options"
+ "group4options := value."
"
- 'group4options ' print. value printNewline.
+ 'group4options ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 296) ifTrue:[
- "resolutionunit"
+ "resolutionunit"
"
- (value == 1) ifTrue:[
- 'res-unit pixel' printNewline
- ] ifFalse:[
- (value == 2) ifTrue:[
- 'res-unit inch' printNewline
- ] ifFalse:[
- (value == 3) ifTrue:[
- 'res-unit mm' printNewline
- ] ifFalse:[
- 'res-unit invalid' printNewline
- ]
- ]
- ].
+ (value == 1) ifTrue:[
+ 'res-unit pixel' printNewline
+ ] ifFalse:[
+ (value == 2) ifTrue:[
+ 'res-unit inch' printNewline
+ ] ifFalse:[
+ (value == 3) ifTrue:[
+ 'res-unit mm' printNewline
+ ] ifFalse:[
+ 'res-unit invalid' printNewline
+ ]
+ ]
+ ].
"
- "resolutionUnit := value."
- ^ self
+ "resolutionUnit := value."
+ ^ self
].
(tagType == 297) ifTrue:[
- "pageNumber"
- "pageNumber := value."
+ "pageNumber"
+ "pageNumber := value."
"
- 'pageNumber ' print. value printNewline.
+ 'pageNumber ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 300) ifTrue:[
- "colorResponceUnit"
+ "colorResponceUnit"
"
- 'colorResponceUnit' print. value printNewline.
+ 'colorResponceUnit' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 301) ifTrue:[
- "colorResponceCurve"
+ "colorResponceCurve"
"
- 'colorResponceCurve' print. value printNewline.
+ 'colorResponceCurve' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 306) ifTrue:[
- "dateTime"
+ "dateTime"
"
- 'dateTime ' print. value printNewline.
+ 'dateTime ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 315) ifTrue:[
- "artist"
+ "artist"
"
- 'artist ' print. value printNewline.
+ 'artist ' print. value printNewline.
"
- ^ self
+ ^ self
].
(tagType == 317) ifTrue:[
- "predictor"
- predictor := value.
+ "predictor"
+ predictor := value.
"
- 'predictor ' print. predictor printNewline.
+ 'predictor ' print. predictor printNewline.
"
- ^ self
+ ^ self
].
(tagType == 320) ifTrue:[
- "colorMap"
+ "colorMap"
"
- 'colorMap (size=' print. valueArray size print. ')' printNewline.
+ 'colorMap (size=' print. valueArray size print. ')' printNewline.
"
- n := valueArray size // 3.
- colorMap := Array new:3.
- colorMap at:1 put:(valueArray copyFrom:1 to:n).
- colorMap at:2 put:(valueArray copyFrom:n+1 to:2*n).
- colorMap at:3 put:(valueArray copyFrom:2*n+1 to:3*n).
- 1 to:3 do:[:c |
- 1 to:n do:[:e |
- val := (colorMap at:c) at:e.
- val := (val * 255.0 / 16rFFFF) rounded.
- (colorMap at:c) at:e put:val
- ]
- ].
- ^ self
+ n := valueArray size // 3.
+ colorMap := Array new:3.
+ colorMap at:1 put:(valueArray copyFrom:1 to:n).
+ colorMap at:2 put:(valueArray copyFrom:n+1 to:2*n).
+ colorMap at:3 put:(valueArray copyFrom:2*n+1 to:3*n).
+
+ scaleFactor := 255.0 / 16rFFFF.
+ 1 to:3 do:[:c |
+ map := colorMap at:c.
+ 1 to:n do:[:e |
+ val := map at:e.
+ val := (val * scaleFactor) rounded.
+ map at:e put:val
+ ]
+ ].
+ ^ self
].
"
@@ -839,22 +850,22 @@
nBytes := data size.
nBytes < 16rFFFF ifTrue:[
- stripOffsets := Array with:(outStream position - 1).
- stripByteCounts := Array with:nBytes.
- outStream nextPutBytes:nBytes from:data.
- rowsPerStrip := height
+ stripOffsets := Array with:(outStream position - 1).
+ stripByteCounts := Array with:nBytes.
+ outStream nextPutBytes:nBytes from:data.
+ rowsPerStrip := height
] ifFalse:[
- stripOffsets := Array new:height.
- bytesPerRow := nBytes // height.
- stripByteCounts := Array new:height withAll:bytesPerRow.
+ stripOffsets := Array new:height.
+ bytesPerRow := nBytes // height.
+ stripByteCounts := Array new:height withAll:bytesPerRow.
- offs := 1.
- 1 to:height do:[:row |
- stripOffsets at:row put:(outStream position - 1).
- outStream nextPutBytes:bytesPerRow from:data startingAt:offs.
- offs := offs + bytesPerRow
- ].
- rowsPerStrip := 1
+ offs := 1.
+ 1 to:height do:[:row |
+ stripOffsets at:row put:(outStream position - 1).
+ outStream nextPutBytes:bytesPerRow from:data startingAt:offs.
+ offs := offs + bytesPerRow
+ ].
+ rowsPerStrip := 1
].
"
'stripOffsets: ' print. stripOffsets printNewline.
@@ -863,17 +874,28 @@
!
writeColorMap
+ |n|
+
colorMapPos := outStream position.
colorMap do:[:subMap |
- subMap do:[:entry |
- "my maps are 8 bit - tiff map is 16 bit"
- entry isNil ifTrue:[
- "unused map entry"
- self writeShort:0
- ] ifFalse:[
- self writeShort:(entry / 255 * 16rFFFF) rounded
- ]
- ]
+ n := 0.
+ subMap do:[:entry |
+ "my maps are 8 bit - tiff map is 16 bit"
+ entry isNil ifTrue:[
+ "unused map entry"
+ self writeShort:0
+ ] ifFalse:[
+ self writeShort:(entry / 255 * 16rFFFF) rounded
+ ].
+ n := n + 1
+ ].
+ "
+ fill to 256 entries
+ "
+ [n < 256] whileTrue:[
+ self writeShort:0.
+ n := n + 1.
+ ]
]
!
@@ -884,7 +906,7 @@
"
stripOffsetsPos := outStream position.
stripOffsets do:[:o |
- self writeLong:o
+ self writeLong:o
]
!
@@ -895,7 +917,7 @@
"
stripByteCountsPos := outStream position.
stripByteCounts do:[:c |
- self writeShort:c
+ self writeShort:c
]
!
@@ -906,7 +928,7 @@
"
bitsPerSamplePos := outStream position.
bitsPerSample do:[:n |
- self writeShort:n
+ self writeShort:n
]
!
@@ -920,61 +942,61 @@
count := 1.
address := nil.
(tagType == 253) ifTrue:[
- "tiff class"
+ "tiff class"
].
(tagType == 254) ifTrue:[
].
(tagType == 255) ifTrue:[
- "SubfileType"
- value := subFileType.
- numberType := #long.
+ "SubfileType"
+ value := subFileType.
+ numberType := #long.
].
(tagType == 256) ifTrue:[
- "ImageWidth"
- value := width.
- numberType := #short.
+ "ImageWidth"
+ value := width.
+ numberType := #short.
].
(tagType == 257) ifTrue:[
- "ImageHeight"
- value := height.
- numberType := #short.
+ "ImageHeight"
+ value := height.
+ numberType := #short.
].
(tagType == 258) ifTrue:[
- "bitspersample"
- address := bitsPerSamplePos - 1.
- numberType := #short.
- count := bitsPerSample size.
- valueArray := bitsPerSample
+ "bitspersample"
+ address := bitsPerSamplePos - 1.
+ numberType := #short.
+ count := bitsPerSample size.
+ valueArray := bitsPerSample
].
(tagType == 259) ifTrue:[
- "compression"
- value := compression.
- numberType := #short.
+ "compression"
+ value := compression.
+ numberType := #short.
].
(tagType == 262) ifTrue:[
- "photometric"
- (photometric == #whiteIs0) ifTrue:[
- value := 0
- ] ifFalse:[
- (photometric == #blackIs0) ifTrue:[
- value := 1
- ] ifFalse:[
- (photometric == #rgb) ifTrue:[
- value := 2
- ] ifFalse:[
- (photometric == #palette) ifTrue:[
- value := 3
- ] ifFalse:[
- (photometric == #transparency) ifTrue:[
- value := 4
- ] ifFalse:[
- self error:'bad photometric'
- ]
- ]
- ]
- ]
- ].
- numberType := #short.
+ "photometric"
+ (photometric == #whiteIs0) ifTrue:[
+ value := 0
+ ] ifFalse:[
+ (photometric == #blackIs0) ifTrue:[
+ value := 1
+ ] ifFalse:[
+ (photometric == #rgb) ifTrue:[
+ value := 2
+ ] ifFalse:[
+ (photometric == #palette) ifTrue:[
+ value := 3
+ ] ifFalse:[
+ (photometric == #transparency) ifTrue:[
+ value := 4
+ ] ifFalse:[
+ self error:'bad photometric'
+ ]
+ ]
+ ]
+ ]
+ ].
+ numberType := #short.
].
(tagType == 263) ifTrue:[
].
@@ -983,17 +1005,17 @@
(tagType == 265) ifTrue:[
].
(tagType == 266) ifTrue:[
- "fillOrder"
- (fillOrder == #msb) ifTrue:[
- value := 1
- ] ifFalse:[
- (fillOrder == #lsb) ifTrue:[
- value := 2
- ] ifFalse:[
- self error:'bad fillOrder'
- ]
- ].
- numberType := #short.
+ "fillOrder"
+ (fillOrder == #msb) ifTrue:[
+ value := 1
+ ] ifFalse:[
+ (fillOrder == #lsb) ifTrue:[
+ value := 2
+ ] ifFalse:[
+ self error:'bad fillOrder'
+ ]
+ ].
+ numberType := #short.
].
(tagType == 269) ifTrue:[
].
@@ -1004,109 +1026,109 @@
(tagType == 272) ifTrue:[
].
(tagType == 273) ifTrue:[
- "stripoffsets"
- address := stripOffsetsPos - 1.
- numberType := #long.
- count := stripOffsets size.
- valueArray := stripOffsets
+ "stripoffsets"
+ address := stripOffsetsPos - 1.
+ numberType := #long.
+ count := stripOffsets size.
+ valueArray := stripOffsets
].
(tagType == 274) ifTrue:[
].
(tagType == 277) ifTrue:[
- "samplesPerPixel"
- value := samplesPerPixel.
- numberType := #short.
+ "samplesPerPixel"
+ value := samplesPerPixel.
+ numberType := #short.
].
(tagType == 278) ifTrue:[
- "rowsperstrip"
- value := rowsPerStrip.
- numberType := #short.
+ "rowsperstrip"
+ value := rowsPerStrip.
+ numberType := #short.
].
(tagType == 279) ifTrue:[
- "stripbytecount"
- address := stripByteCountsPos - 1.
- numberType := #short.
- count := stripByteCounts size.
- valueArray := stripByteCounts
+ "stripbytecount"
+ address := stripByteCountsPos - 1.
+ numberType := #short.
+ count := stripByteCounts size.
+ valueArray := stripByteCounts
].
(tagType == 280) ifTrue:[
- "min sample value"
+ "min sample value"
].
(tagType == 281) ifTrue:[
- "max sample value"
+ "max sample value"
].
(tagType == 282) ifTrue:[
- "x resolution"
+ "x resolution"
].
(tagType == 283) ifTrue:[
- "y resolution"
+ "y resolution"
].
(tagType == 284) ifTrue:[
- "planarconfig"
- value := planarConfiguration.
- numberType := #short.
+ "planarconfig"
+ value := planarConfiguration.
+ numberType := #short.
].
(tagType == 285) ifTrue:[
- "pageName"
+ "pageName"
].
(tagType == 286) ifTrue:[
- "xPosition"
+ "xPosition"
].
(tagType == 287) ifTrue:[
- "yPosition"
+ "yPosition"
].
(tagType == 288) ifTrue:[
- "freeOffsets"
+ "freeOffsets"
].
(tagType == 289) ifTrue:[
- "freeByteCounts"
+ "freeByteCounts"
].
(tagType == 290) ifTrue:[
- "grayResponceUnit"
+ "grayResponceUnit"
].
(tagType == 291) ifTrue:[
- "grayResponceCurve"
+ "grayResponceCurve"
].
(tagType == 292) ifTrue:[
- "group3options"
- value := group3options.
- numberType := #long.
+ "group3options"
+ value := group3options.
+ numberType := #long.
].
(tagType == 293) ifTrue:[
- "group4options"
+ "group4options"
].
(tagType == 296) ifTrue:[
- "resolutionunit"
- ^ self
+ "resolutionunit"
+ ^ self
].
(tagType == 297) ifTrue:[
- "pageNumber"
+ "pageNumber"
].
(tagType == 300) ifTrue:[
- "colorResponceUnit"
+ "colorResponceUnit"
].
(tagType == 301) ifTrue:[
- "colorResponceCurve"
+ "colorResponceCurve"
].
(tagType == 306) ifTrue:[
- "dateTime"
+ "dateTime"
].
(tagType == 315) ifTrue:[
- "artist"
+ "artist"
].
(tagType == 317) ifTrue:[
- "predictor"
+ "predictor"
].
(tagType == 320) ifTrue:[
- "colormap"
- address := colorMapPos - 1.
- numberType := #short.
- count := (colorMap at:1) size * 3.
+ "colormap"
+ address := colorMapPos - 1.
+ numberType := #short.
+ count := 256 "(colorMap at:1) size" * 3.
].
(value isNil and:[address isNil]) ifTrue:[
- self error:'unhandled tag'.
- ^ self
+ self error:'unhandled tag'.
+ ^ self
].
"
@@ -1117,73 +1139,73 @@
self writeShort:tagType.
numberType == #short ifTrue:[
- self writeShort:3.
- self writeLong:count.
+ self writeShort:3.
+ self writeLong:count.
] ifFalse:[
- numberType == #long ifTrue:[
- self writeShort:4.
- self writeLong:count.
- ] ifFalse:[
- numberType == #byte ifTrue:[
- self writeShort:1.
- self writeLong:count.
- ] ifFalse:[
- self error:'bad numbertype'
- ]
- ]
+ numberType == #long ifTrue:[
+ self writeShort:4.
+ self writeLong:count.
+ ] ifFalse:[
+ numberType == #byte ifTrue:[
+ self writeShort:1.
+ self writeLong:count.
+ ] ifFalse:[
+ self error:'bad numbertype'
+ ]
+ ]
].
address notNil ifTrue:[
- (numberType == #long and:[count == 1]) ifTrue:[
- self writeLong:(valueArray at:1).
- ^ self
- ].
- (numberType == #short and:[count <= 2]) ifTrue:[
- self writeShort:(valueArray at:1).
- count == 2 ifTrue:[
- self writeShort:(valueArray at:2).
- ] ifFalse:[
- self writeShort:0
- ].
- ^ self
- ].
- (numberType == #byte and:[count <= 4]) ifTrue:[
- outStream nextPut:(valueArray at:1).
- count > 1 ifTrue:[
- outStream nextPut:(valueArray at:2).
- count > 2 ifTrue:[
- outStream nextPut:(valueArray at:3).
- count > 3 ifTrue:[
- outStream nextPut:(valueArray at:4).
- ] ifFalse:[
- outStream nextPut:0
- ].
- ] ifFalse:[
- outStream nextPut:0
- ].
- ] ifFalse:[
- outStream nextPut:0
- ].
- ^ self
- ].
- self writeLong:address.
- ^ self
+ (numberType == #long and:[count == 1]) ifTrue:[
+ self writeLong:(valueArray at:1).
+ ^ self
+ ].
+ (numberType == #short and:[count <= 2]) ifTrue:[
+ self writeShort:(valueArray at:1).
+ count == 2 ifTrue:[
+ self writeShort:(valueArray at:2).
+ ] ifFalse:[
+ self writeShort:0
+ ].
+ ^ self
+ ].
+ (numberType == #byte and:[count <= 4]) ifTrue:[
+ outStream nextPut:(valueArray at:1).
+ count > 1 ifTrue:[
+ outStream nextPut:(valueArray at:2).
+ count > 2 ifTrue:[
+ outStream nextPut:(valueArray at:3).
+ count > 3 ifTrue:[
+ outStream nextPut:(valueArray at:4).
+ ] ifFalse:[
+ outStream nextPut:0
+ ].
+ ] ifFalse:[
+ outStream nextPut:0
+ ].
+ ] ifFalse:[
+ outStream nextPut:0
+ ].
+ ^ self
+ ].
+ self writeLong:address.
+ ^ self
].
numberType == #short ifTrue:[
- self writeShort:value.
- self writeShort:0
+ self writeShort:value.
+ self writeShort:0
] ifFalse:[
- numberType == #long ifTrue:[
- self writeLong:value
- ] ifFalse:[
- numberType == #byte ifTrue:[
- outStream nextPut:value.
- outStream nextPut:0.
- outStream nextPut:0.
- outStream nextPut:0.
- ] ifFalse:[
- self error:'bad numbertype'
- ]
- ]
+ numberType == #long ifTrue:[
+ self writeLong:value
+ ] ifFalse:[
+ numberType == #byte ifTrue:[
+ outStream nextPut:value.
+ outStream nextPut:0.
+ outStream nextPut:0.
+ outStream nextPut:0.
+ ] ifFalse:[
+ self error:'bad numbertype'
+ ]
+ ]
].
!
@@ -1202,37 +1224,37 @@
or rgb - if non separate planes and no alpha"
(nPlanes == 2) ifTrue:[
- (planarConfiguration ~~ 2) ifTrue:[
- self error:'with alpha, only separate planes supported'.
- ^ nil
- ].
- 'TIFFReader: ignoring alpha plane' errorPrintNL.
- nPlanes := 1.
- bitsPerPixel := bitsPerSample at:1
+ (planarConfiguration ~~ 2) ifTrue:[
+ self error:'with alpha, only separate planes supported'.
+ ^ nil
+ ].
+ 'TIFFReader: ignoring alpha plane' errorPrintNL.
+ nPlanes := 1.
+ bitsPerPixel := bitsPerSample at:1
] ifFalse:[
- (nPlanes == 3) ifTrue:[
- (planarConfiguration ~~ 1) ifTrue:[
- self error:'only non separate planes supported'.
- ^ nil
- ].
- bitsPerSample ~= #(8 8 8) ifTrue:[
- self error:'only 8/8/8 rgb images supported'.
- ^ nil
- ].
- bitsPerPixel := 24
- ] ifFalse:[
- (nPlanes ~~ 1) ifTrue:[
- self error:'format not supported'.
- ^ nil
- ].
- bitsPerPixel := bitsPerSample at:1
- ]
+ (nPlanes == 3) ifTrue:[
+ (planarConfiguration ~~ 1) ifTrue:[
+ self error:'only non separate planes supported'.
+ ^ nil
+ ].
+ bitsPerSample ~= #(8 8 8) ifTrue:[
+ self error:'only 8/8/8 rgb images supported'.
+ ^ nil
+ ].
+ bitsPerPixel := 24
+ ] ifFalse:[
+ (nPlanes ~~ 1) ifTrue:[
+ self error:'format not supported'.
+ ^ nil
+ ].
+ bitsPerPixel := bitsPerSample at:1
+ ]
].
bitsPerRow := width * bitsPerPixel.
bytesPerRow := bitsPerRow // 8.
((bitsPerRow \\ 8) ~~ 0) ifTrue:[
- bytesPerRow := bytesPerRow + 1
+ bytesPerRow := bytesPerRow + 1
].
overAllBytes := bytesPerRow * height.
@@ -1243,13 +1265,13 @@
row := 1.
[row <= height] whileTrue:[
- stripNr := stripNr + 1.
- nBytes := stripByteCounts at:stripNr.
- inStream position:((stripOffsets at:stripNr) + 1).
+ stripNr := stripNr + 1.
+ nBytes := stripByteCounts at:stripNr.
+ inStream position:((stripOffsets at:stripNr) + 1).
- inStream nextBytes:nBytes into:data startingAt:offset.
- offset := offset + nBytes.
- row := row + rowsPerStrip
+ inStream nextBytes:nBytes into:data startingAt:offset.
+ offset := offset + nBytes.
+ row := row + rowsPerStrip
]
!
@@ -1271,38 +1293,38 @@
nPlanes := samplesPerPixel.
(nPlanes == 3) ifTrue:[
- ((bitsPerSample at:1) ~~ 8) ifTrue:[
- self error:'only 8 bit/sample supported'.
- ^ nil
- ].
- ((bitsPerSample at:2) ~~ 8) ifTrue:[
- self error:'only 8 bit/sample supported'.
- ^ nil
- ].
- ((bitsPerSample at:3) ~~ 8) ifTrue:[
- self error:'only 8 bit/sample supported'.
- ^ nil
- ].
- bytesPerRow := width * samplesPerPixel.
+ ((bitsPerSample at:1) ~~ 8) ifTrue:[
+ self error:'only 8 bit/sample supported'.
+ ^ nil
+ ].
+ ((bitsPerSample at:2) ~~ 8) ifTrue:[
+ self error:'only 8 bit/sample supported'.
+ ^ nil
+ ].
+ ((bitsPerSample at:3) ~~ 8) ifTrue:[
+ self error:'only 8 bit/sample supported'.
+ ^ nil
+ ].
+ bytesPerRow := width * samplesPerPixel.
] ifFalse:[
- (nPlanes == 2) ifTrue:[
- (planarConfiguration ~~ 2) ifTrue:[
- self error:'only separate planes supported'.
- ^ nil
- ].
- 'TIFFReader: ignoring alpha plane' errorPrintNL.
- nPlanes := 1
- ].
- (nPlanes == 1) ifFalse:[
- self error:'only 3-sample rgb / monochrome supported'.
- ^ nil
- ].
- bytesPerRow := (width * (bitsPerSample at:1) + 7) // 8.
+ (nPlanes == 2) ifTrue:[
+ (planarConfiguration ~~ 2) ifTrue:[
+ self error:'only separate planes supported'.
+ ^ nil
+ ].
+ 'TIFFReader: ignoring alpha plane' errorPrintNL.
+ nPlanes := 1
+ ].
+ (nPlanes == 1) ifFalse:[
+ self error:'only 3-sample rgb / monochrome supported'.
+ ^ nil
+ ].
+ bytesPerRow := (width * (bitsPerSample at:1) + 7) // 8.
].
stripByteCounts isNil ifTrue:[
- self error:'currently require stripByteCounts'.
- ^ nil
+ self error:'currently require stripByteCounts'.
+ ^ nil
].
'TIFFReader: decompressing LZW ...' errorPrintNL.
@@ -1316,25 +1338,25 @@
bytesPerStrip := bytesPerRow * rowsPerStrip.
prevSize := 0.
[row <= height] whileTrue:[
- stripNr := stripNr + 1.
- inStream position:((stripOffsets at:stripNr) + 1).
- nBytes := stripByteCounts at:stripNr.
- (nBytes > prevSize) ifTrue:[
- compressedStrip := ByteArray uninitializedNew:nBytes.
- prevSize := nBytes
- ].
- inStream nextBytes:nBytes
- into:compressedStrip.
- self class decompressLZWFrom:compressedStrip
- count:nBytes
- into:data
- startingAt:offset.
- offset := offset + bytesPerStrip.
- row := row + rowsPerStrip
+ stripNr := stripNr + 1.
+ inStream position:((stripOffsets at:stripNr) + 1).
+ nBytes := stripByteCounts at:stripNr.
+ (nBytes > prevSize) ifTrue:[
+ compressedStrip := ByteArray uninitializedNew:nBytes.
+ prevSize := nBytes
+ ].
+ inStream nextBytes:nBytes
+ into:compressedStrip.
+ self class decompressLZWFrom:compressedStrip
+ count:nBytes
+ into:data
+ startingAt:offset.
+ offset := offset + bytesPerStrip.
+ row := row + rowsPerStrip
].
(predictor == 2) ifTrue:[
- self class decodeDelta:3 in:data width:width height:height
+ self class decodeDelta:3 in:data width:width height:height
]
!
@@ -1350,22 +1372,22 @@
nPlanes := samplesPerPixel.
(nPlanes == 2) ifTrue:[
- 'TIFFReader: ignoring alpha plane' errorPrintNL.
- nPlanes := 1
+ 'TIFFReader: ignoring alpha plane' errorPrintNL.
+ nPlanes := 1
].
(nPlanes ~~ 1) ifTrue:[
- self error:'only monochrome/greyscale supported'.
- ^ nil
+ self error:'only monochrome/greyscale supported'.
+ ^ nil
].
stripByteCounts isNil ifTrue:[
- self error:'currently require stripByteCounts'.
- ^ nil
+ self error:'currently require stripByteCounts'.
+ ^ nil
].
(rowsPerStrip ~~ 1) isNil ifTrue:[
- self error:'currently require rowsPerStrip to be 1'.
- ^ nil
+ self error:'currently require rowsPerStrip to be 1'.
+ ^ nil
].
'TIFFReader: decompressing CCITT-3 ...' errorPrintNL.
@@ -1373,7 +1395,7 @@
bitsPerRow := width * (bitsPerSample at:1).
bytesPerRow := bitsPerRow // 8.
((bitsPerRow \\ 8) ~~ 0) ifTrue:[
- bytesPerRow := bytesPerRow + 1
+ bytesPerRow := bytesPerRow + 1
].
data := ByteArray new:(bytesPerRow * height).
@@ -1385,15 +1407,15 @@
row := 1.
bytesPerStrip := bytesPerRow * rowsPerStrip.
[row <= height] whileTrue:[
- stripNr := stripNr + 1.
- inStream position:((stripOffsets at:stripNr) + 1).
- inStream nextBytes:(stripByteCounts at:stripNr) into:compressedStrip.
- self class decompressCCITT3From:compressedStrip
- into:data
- startingAt:offset
- count:width.
- offset := offset + bytesPerStrip.
- row := row + rowsPerStrip
+ stripNr := stripNr + 1.
+ inStream position:((stripOffsets at:stripNr) + 1).
+ inStream nextBytes:(stripByteCounts at:stripNr) into:compressedStrip.
+ self class decompressCCITT3From:compressedStrip
+ into:data
+ startingAt:offset
+ count:width.
+ offset := offset + bytesPerStrip.
+ row := row + rowsPerStrip
]
!
--- a/WinIconRdr.st Mon Oct 10 03:32:51 1994 +0100
+++ b/WinIconRdr.st Mon Oct 10 03:34:22 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -11,17 +11,17 @@
"
ImageReader subclass:#WindowsIconReader
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
WindowsIconReader comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libview2/Attic/WinIconRdr.st,v 1.7 1994-08-05 01:16:24 claus Exp $
+$Header: /cvs/stx/stx/libview2/Attic/WinIconRdr.st,v 1.8 1994-10-10 02:34:13 claus Exp $
'!
!WindowsIconReader class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/Attic/WinIconRdr.st,v 1.7 1994-08-05 01:16:24 claus Exp $
+$Header: /cvs/stx/stx/libview2/Attic/WinIconRdr.st,v 1.8 1994-10-10 02:34:13 claus Exp $
"
!
@@ -52,6 +52,13 @@
"
! !
+!WindowsIconReader class methodsFor:'initialization'!
+
+initialize
+ Image fileFormats at:'.bmp' put:self.
+ Image fileFormats at:'.ico' put:self.
+! !
+
!WindowsIconReader methodsFor:'reading from file'!
fromOS2File: aFilename
@@ -108,13 +115,13 @@
bMap := Array new:16.
srcIndex := 1.
1 to:16 do:[:i |
- bMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- gMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- rMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- srcIndex := srcIndex + 1.
+ bMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ gMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ rMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ srcIndex := srcIndex + 1.
].
"read the data bits"
@@ -136,10 +143,10 @@
srcIndex := 1.
dstIndex := (height - 1) * bytesPerRow + 1.
1 to:height do:[:row |
- tmp replaceFrom:dstIndex to:(dstIndex + bytesPerRow - 1)
- with:data4 startingAt:srcIndex.
- srcIndex := srcIndex + bytesPerRow.
- dstIndex := dstIndex - bytesPerRow.
+ tmp replaceFrom:dstIndex to:(dstIndex + bytesPerRow - 1)
+ with:data4 startingAt:srcIndex.
+ srcIndex := srcIndex + bytesPerRow.
+ dstIndex := dstIndex - bytesPerRow.
].
data4 := tmp.
@@ -147,7 +154,7 @@
data := ByteArray new:(width * height).
data4 expandPixels:inDepth width:width height:height
- into:data mapping:nil.
+ into:data mapping:nil.
photometric := #palette.
samplesPerPixel := 1.
@@ -174,59 +181,59 @@
inStream nextBytes:18 into:header.
((header at:(16r0E + 1)) == 40) ifTrue:[ "header-size"
- "
- its an Windows3.x BMP file
- or OS/2 vsn 2 BMP file
- "
- 'BMP: Win3.x or OS/2 vsn 2 format' errorPrintNL.
+ "
+ its an Windows3.x BMP file
+ or OS/2 vsn 2 BMP file
+ "
+ 'BMP: Win3.x or OS/2 vsn 2 format' errorPrintNL.
- inStream nextBytes:(40-4) into:header startingAt:19.
+ inStream nextBytes:(40-4) into:header startingAt:19.
- width := header wordAt:(16r12 + 1). "(header at:19) + ((header at:20) * 256). "
- height := header wordAt:(16r16 + 1). "(header at:23) + ((header at:24) * 256). "
- inPlanes := header wordAt:(16r1A + 1).
- inDepth := header wordAt:(16r1C + 1).
- compression := header wordAt:(16r1E + 1).
- imgSize := header doubleWordAt:(16r22 + 1).
- resH := header doubleWordAt:(16r26 + 1).
- resV := header doubleWordAt:(16r2A + 1).
- numColor := header doubleWordAt:(16r2E + 1).
- numImportantColor := header doubleWordAt:(16r32 + 1).
+ width := header wordAt:(16r12 + 1). "(header at:19) + ((header at:20) * 256). "
+ height := header wordAt:(16r16 + 1). "(header at:23) + ((header at:24) * 256). "
+ inPlanes := header wordAt:(16r1A + 1).
+ inDepth := header wordAt:(16r1C + 1).
+ compression := header wordAt:(16r1E + 1).
+ imgSize := header doubleWordAt:(16r22 + 1).
+ resH := header doubleWordAt:(16r26 + 1).
+ resV := header doubleWordAt:(16r2A + 1).
+ numColor := header doubleWordAt:(16r2E + 1).
+ numImportantColor := header doubleWordAt:(16r32 + 1).
- numColor == 0 ifTrue:[
- "
- some bmp-writers seem to leave this as zero (which is wrong)
- "
- numColor := 1 bitShift:inDepth.
- 'BMP: missing nColor in header - assume ' errorPrint. numColor errorPrintNL
- ].
- rawMap := ByteArray uninitializedNew:(numColor * 4).
- inStream nextBytes:(numColor * 4) into:rawMap.
- fourBytesPerColorInfo := true.
- dataStart := header wordAt:(16r0A + 1)
+ numColor == 0 ifTrue:[
+ "
+ some bmp-writers seem to leave this as zero (which is wrong)
+ "
+ numColor := 1 bitShift:inDepth.
+ 'BMP: missing nColor in header - assume ' errorPrint. numColor errorPrintNL
+ ].
+ rawMap := ByteArray uninitializedNew:(numColor * 4).
+ inStream nextBytes:(numColor * 4) into:rawMap.
+ fourBytesPerColorInfo := true.
+ dataStart := header wordAt:(16r0A + 1)
] ifFalse:[
- ((header at:(16r0E + 1)) == 12) ifTrue:[ "core-info header size"
- "
- its an OS/2 (vsn1.2) BMP file
- "
- 'BMP: OS/2 vsn 1.2 format' errorPrintNL.
- inStream nextBytes:(12-4) into:header startingAt:19.
+ ((header at:(16r0E + 1)) == 12) ifTrue:[ "core-info header size"
+ "
+ its an OS/2 (vsn1.2) BMP file
+ "
+ 'BMP: OS/2 vsn 1.2 format' errorPrintNL.
+ inStream nextBytes:(12-4) into:header startingAt:19.
- width := header wordAt:(16r12 + 1). "(header at:19) + ((header at:20) * 256). "
- height := header wordAt:(16r14 + 1). "(header at:21) + ((header at:22) * 256). "
- inPlanes := header wordAt:(16r16 + 1).
- inDepth := header wordAt:(16r18 + 1).
- numColor := 1 bitShift:inDepth.
- rawMap := ByteArray uninitializedNew:(numColor * 3).
- inStream nextBytes:(numColor * 3) into:rawMap.
- fourBytesPerColorInfo := false.
- compression := 0.
- dataStart := header wordAt:(16r0A + 1)
- ] ifFalse:[
- 'BMP: unknown format' errorPrintNL.
- inStream close.
- ^ nil
- ].
+ width := header wordAt:(16r12 + 1). "(header at:19) + ((header at:20) * 256). "
+ height := header wordAt:(16r14 + 1). "(header at:21) + ((header at:22) * 256). "
+ inPlanes := header wordAt:(16r16 + 1).
+ inDepth := header wordAt:(16r18 + 1).
+ numColor := 1 bitShift:inDepth.
+ rawMap := ByteArray uninitializedNew:(numColor * 3).
+ inStream nextBytes:(numColor * 3) into:rawMap.
+ fourBytesPerColorInfo := false.
+ compression := 0.
+ dataStart := header wordAt:(16r0A + 1)
+ ] ifFalse:[
+ 'BMP: unknown format' errorPrintNL.
+ inStream close.
+ ^ nil
+ ].
].
"read the colormap"
@@ -236,15 +243,15 @@
bMap := Array new:numColor.
srcIndex := 1.
1 to:numColor do:[:i |
- bMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- gMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- rMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- fourBytesPerColorInfo ifTrue:[
- srcIndex := srcIndex + 1.
- ]
+ bMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ gMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ rMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ fourBytesPerColorInfo ifTrue:[
+ srcIndex := srcIndex + 1.
+ ]
].
"
@@ -252,15 +259,15 @@
supported
"
compression ~~ 0 ifTrue:[
- 'BMP compression type ' errorPrint. compression errorPrint.
- 'not supported' errorPrintNL.
- inStream close.
- ^ nil
+ 'BMP compression type ' errorPrint. compression errorPrint.
+ 'not supported' errorPrintNL.
+ inStream close.
+ ^ nil
].
inPlanes ~~ 1 ifTrue:[
- 'BMP only 1 plane images supported' errorPrintNL.
- inStream close.
- ^ nil
+ 'BMP only 1 plane images supported' errorPrintNL.
+ inStream close.
+ ^ nil
].
"read the data bits"
@@ -284,10 +291,10 @@
srcIndex := 1.
dstIndex := (height - 1) * bytesPerRow + 1.
1 to:height do:[:row |
- tmp replaceFrom:dstIndex to:(dstIndex + bytesPerRow - 1)
- with:data4 startingAt:srcIndex.
- srcIndex := srcIndex + bytesPerRow.
- dstIndex := dstIndex - bytesPerRow.
+ tmp replaceFrom:dstIndex to:(dstIndex + bytesPerRow - 1)
+ with:data4 startingAt:srcIndex.
+ srcIndex := srcIndex + bytesPerRow.
+ dstIndex := dstIndex - bytesPerRow.
].
data4 := tmp.
@@ -295,7 +302,7 @@
data := ByteArray new:(width * height).
data4 expandPixels:inDepth width:width height:height
- into:data mapping:nil.
+ into:data mapping:nil.
photometric := #palette.
samplesPerPixel := 1.
@@ -314,38 +321,38 @@
fileSize := inStream size.
fileSize < 16 ifTrue:[
- inStream close.
- self error:'WINREADER: short file'.
- ^ nil
+ inStream close.
+ self error:'WINREADER: short file'.
+ ^ nil
].
header := ByteArray uninitializedNew:4.
inStream nextBytes:4 into:header.
(header startsWith:#(66 77)) ifTrue:[ "BM"
- inStream position:1.
- 'WINREADER: Win3.x or OS/2 vsn 2 BM format' errorPrintNL.
- ^ self fromWindowsBMPStream
+ inStream position:1.
+ 'WINREADER: Win3.x or OS/2 vsn 2 BM format' errorPrintNL.
+ ^ self fromWindowsBMPStream
].
(header startsWith:#(66 65)) ifTrue:[ "BA"
- inStream position:1.
- 'WINREADER: OS/2 vsn 2 BA format' errorPrintNL.
- ^ self fromOS2Stream
+ inStream position:1.
+ 'WINREADER: OS/2 vsn 2 BA format' errorPrintNL.
+ ^ self fromOS2Stream
].
(header startsWith:#(73 67)) ifTrue:[ "IC"
- inStream position:1.
- 'WINREADER: OS/2 IC format' errorPrintNL.
- ^ self fromOS2Stream
+ inStream position:1.
+ 'WINREADER: OS/2 IC format' errorPrintNL.
+ ^ self fromOS2Stream
].
(header startsWith:#(80 84)) ifTrue:[ "PT"
- inStream position:1.
- 'WINREADER: OS/2 PT format' errorPrintNL.
- ^ self fromOS2Stream
+ inStream position:1.
+ 'WINREADER: OS/2 PT format' errorPrintNL.
+ ^ self fromOS2Stream
].
(header startsWith:#(0 0 1 0)) ifTrue:[
- inStream position:1.
- 'WINREADER: Win3.x ICO format' errorPrintNL.
- ^ self fromWindowsICOStream
+ inStream position:1.
+ 'WINREADER: Win3.x ICO format' errorPrintNL.
+ ^ self fromWindowsICOStream
].
self error:'WINREADER: format not supported'.
inStream close.
@@ -369,16 +376,16 @@
inStream nextBytes:16 into:header.
(header startsWith:#(73 67)) ifTrue:[
- "IC format"
- inStream nextBytes:10 into:header startingAt:17.
- width := header at:7.
- height := header at:9.
- inDepth := 2 "header at:11". "where is it"
+ "IC format"
+ inStream nextBytes:10 into:header startingAt:17.
+ width := header at:7.
+ height := header at:9.
+ inDepth := 2 "header at:11". "where is it"
] ifFalse:[
- inStream nextBytes:(8r110-16) into:header startingAt:17.
- width := header at:8r101.
- height := header at:8r103.
- inDepth := header at:8r107.
+ inStream nextBytes:(8r110-16) into:header startingAt:17.
+ width := header at:8r101.
+ height := header at:8r103.
+ inDepth := header at:8r107.
].
"read the colormap"
@@ -392,12 +399,12 @@
bMap := Array new:nColors.
srcIndex := 1.
1 to:nColors do:[:i |
- bMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- gMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- rMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
+ bMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ gMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ rMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
].
"read mask"
@@ -422,10 +429,10 @@
srcIndex := 1.
dstIndex := (height - 1) * bytesPerRow + 1.
1 to:height do:[:row |
- tmp replaceFrom:dstIndex to:(dstIndex + bytesPerRow - 1)
- with:data4 startingAt:srcIndex.
- srcIndex := srcIndex + bytesPerRow.
- dstIndex := dstIndex - bytesPerRow.
+ tmp replaceFrom:dstIndex to:(dstIndex + bytesPerRow - 1)
+ with:data4 startingAt:srcIndex.
+ srcIndex := srcIndex + bytesPerRow.
+ dstIndex := dstIndex - bytesPerRow.
].
data4 := tmp.
@@ -433,7 +440,7 @@
data := ByteArray new:(width * height).
data4 expandPixels:inDepth width:width height:height
- into:data mapping:nil.
+ into:data mapping:nil.
photometric := #palette.
samplesPerPixel := 1.
--- a/WindowsIconReader.st Mon Oct 10 03:32:51 1994 +0100
+++ b/WindowsIconReader.st Mon Oct 10 03:34:22 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -11,17 +11,17 @@
"
ImageReader subclass:#WindowsIconReader
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
WindowsIconReader comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libview2/WindowsIconReader.st,v 1.7 1994-08-05 01:16:24 claus Exp $
+$Header: /cvs/stx/stx/libview2/WindowsIconReader.st,v 1.8 1994-10-10 02:34:13 claus Exp $
'!
!WindowsIconReader class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/WindowsIconReader.st,v 1.7 1994-08-05 01:16:24 claus Exp $
+$Header: /cvs/stx/stx/libview2/WindowsIconReader.st,v 1.8 1994-10-10 02:34:13 claus Exp $
"
!
@@ -52,6 +52,13 @@
"
! !
+!WindowsIconReader class methodsFor:'initialization'!
+
+initialize
+ Image fileFormats at:'.bmp' put:self.
+ Image fileFormats at:'.ico' put:self.
+! !
+
!WindowsIconReader methodsFor:'reading from file'!
fromOS2File: aFilename
@@ -108,13 +115,13 @@
bMap := Array new:16.
srcIndex := 1.
1 to:16 do:[:i |
- bMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- gMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- rMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- srcIndex := srcIndex + 1.
+ bMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ gMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ rMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ srcIndex := srcIndex + 1.
].
"read the data bits"
@@ -136,10 +143,10 @@
srcIndex := 1.
dstIndex := (height - 1) * bytesPerRow + 1.
1 to:height do:[:row |
- tmp replaceFrom:dstIndex to:(dstIndex + bytesPerRow - 1)
- with:data4 startingAt:srcIndex.
- srcIndex := srcIndex + bytesPerRow.
- dstIndex := dstIndex - bytesPerRow.
+ tmp replaceFrom:dstIndex to:(dstIndex + bytesPerRow - 1)
+ with:data4 startingAt:srcIndex.
+ srcIndex := srcIndex + bytesPerRow.
+ dstIndex := dstIndex - bytesPerRow.
].
data4 := tmp.
@@ -147,7 +154,7 @@
data := ByteArray new:(width * height).
data4 expandPixels:inDepth width:width height:height
- into:data mapping:nil.
+ into:data mapping:nil.
photometric := #palette.
samplesPerPixel := 1.
@@ -174,59 +181,59 @@
inStream nextBytes:18 into:header.
((header at:(16r0E + 1)) == 40) ifTrue:[ "header-size"
- "
- its an Windows3.x BMP file
- or OS/2 vsn 2 BMP file
- "
- 'BMP: Win3.x or OS/2 vsn 2 format' errorPrintNL.
+ "
+ its an Windows3.x BMP file
+ or OS/2 vsn 2 BMP file
+ "
+ 'BMP: Win3.x or OS/2 vsn 2 format' errorPrintNL.
- inStream nextBytes:(40-4) into:header startingAt:19.
+ inStream nextBytes:(40-4) into:header startingAt:19.
- width := header wordAt:(16r12 + 1). "(header at:19) + ((header at:20) * 256). "
- height := header wordAt:(16r16 + 1). "(header at:23) + ((header at:24) * 256). "
- inPlanes := header wordAt:(16r1A + 1).
- inDepth := header wordAt:(16r1C + 1).
- compression := header wordAt:(16r1E + 1).
- imgSize := header doubleWordAt:(16r22 + 1).
- resH := header doubleWordAt:(16r26 + 1).
- resV := header doubleWordAt:(16r2A + 1).
- numColor := header doubleWordAt:(16r2E + 1).
- numImportantColor := header doubleWordAt:(16r32 + 1).
+ width := header wordAt:(16r12 + 1). "(header at:19) + ((header at:20) * 256). "
+ height := header wordAt:(16r16 + 1). "(header at:23) + ((header at:24) * 256). "
+ inPlanes := header wordAt:(16r1A + 1).
+ inDepth := header wordAt:(16r1C + 1).
+ compression := header wordAt:(16r1E + 1).
+ imgSize := header doubleWordAt:(16r22 + 1).
+ resH := header doubleWordAt:(16r26 + 1).
+ resV := header doubleWordAt:(16r2A + 1).
+ numColor := header doubleWordAt:(16r2E + 1).
+ numImportantColor := header doubleWordAt:(16r32 + 1).
- numColor == 0 ifTrue:[
- "
- some bmp-writers seem to leave this as zero (which is wrong)
- "
- numColor := 1 bitShift:inDepth.
- 'BMP: missing nColor in header - assume ' errorPrint. numColor errorPrintNL
- ].
- rawMap := ByteArray uninitializedNew:(numColor * 4).
- inStream nextBytes:(numColor * 4) into:rawMap.
- fourBytesPerColorInfo := true.
- dataStart := header wordAt:(16r0A + 1)
+ numColor == 0 ifTrue:[
+ "
+ some bmp-writers seem to leave this as zero (which is wrong)
+ "
+ numColor := 1 bitShift:inDepth.
+ 'BMP: missing nColor in header - assume ' errorPrint. numColor errorPrintNL
+ ].
+ rawMap := ByteArray uninitializedNew:(numColor * 4).
+ inStream nextBytes:(numColor * 4) into:rawMap.
+ fourBytesPerColorInfo := true.
+ dataStart := header wordAt:(16r0A + 1)
] ifFalse:[
- ((header at:(16r0E + 1)) == 12) ifTrue:[ "core-info header size"
- "
- its an OS/2 (vsn1.2) BMP file
- "
- 'BMP: OS/2 vsn 1.2 format' errorPrintNL.
- inStream nextBytes:(12-4) into:header startingAt:19.
+ ((header at:(16r0E + 1)) == 12) ifTrue:[ "core-info header size"
+ "
+ its an OS/2 (vsn1.2) BMP file
+ "
+ 'BMP: OS/2 vsn 1.2 format' errorPrintNL.
+ inStream nextBytes:(12-4) into:header startingAt:19.
- width := header wordAt:(16r12 + 1). "(header at:19) + ((header at:20) * 256). "
- height := header wordAt:(16r14 + 1). "(header at:21) + ((header at:22) * 256). "
- inPlanes := header wordAt:(16r16 + 1).
- inDepth := header wordAt:(16r18 + 1).
- numColor := 1 bitShift:inDepth.
- rawMap := ByteArray uninitializedNew:(numColor * 3).
- inStream nextBytes:(numColor * 3) into:rawMap.
- fourBytesPerColorInfo := false.
- compression := 0.
- dataStart := header wordAt:(16r0A + 1)
- ] ifFalse:[
- 'BMP: unknown format' errorPrintNL.
- inStream close.
- ^ nil
- ].
+ width := header wordAt:(16r12 + 1). "(header at:19) + ((header at:20) * 256). "
+ height := header wordAt:(16r14 + 1). "(header at:21) + ((header at:22) * 256). "
+ inPlanes := header wordAt:(16r16 + 1).
+ inDepth := header wordAt:(16r18 + 1).
+ numColor := 1 bitShift:inDepth.
+ rawMap := ByteArray uninitializedNew:(numColor * 3).
+ inStream nextBytes:(numColor * 3) into:rawMap.
+ fourBytesPerColorInfo := false.
+ compression := 0.
+ dataStart := header wordAt:(16r0A + 1)
+ ] ifFalse:[
+ 'BMP: unknown format' errorPrintNL.
+ inStream close.
+ ^ nil
+ ].
].
"read the colormap"
@@ -236,15 +243,15 @@
bMap := Array new:numColor.
srcIndex := 1.
1 to:numColor do:[:i |
- bMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- gMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- rMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- fourBytesPerColorInfo ifTrue:[
- srcIndex := srcIndex + 1.
- ]
+ bMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ gMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ rMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ fourBytesPerColorInfo ifTrue:[
+ srcIndex := srcIndex + 1.
+ ]
].
"
@@ -252,15 +259,15 @@
supported
"
compression ~~ 0 ifTrue:[
- 'BMP compression type ' errorPrint. compression errorPrint.
- 'not supported' errorPrintNL.
- inStream close.
- ^ nil
+ 'BMP compression type ' errorPrint. compression errorPrint.
+ 'not supported' errorPrintNL.
+ inStream close.
+ ^ nil
].
inPlanes ~~ 1 ifTrue:[
- 'BMP only 1 plane images supported' errorPrintNL.
- inStream close.
- ^ nil
+ 'BMP only 1 plane images supported' errorPrintNL.
+ inStream close.
+ ^ nil
].
"read the data bits"
@@ -284,10 +291,10 @@
srcIndex := 1.
dstIndex := (height - 1) * bytesPerRow + 1.
1 to:height do:[:row |
- tmp replaceFrom:dstIndex to:(dstIndex + bytesPerRow - 1)
- with:data4 startingAt:srcIndex.
- srcIndex := srcIndex + bytesPerRow.
- dstIndex := dstIndex - bytesPerRow.
+ tmp replaceFrom:dstIndex to:(dstIndex + bytesPerRow - 1)
+ with:data4 startingAt:srcIndex.
+ srcIndex := srcIndex + bytesPerRow.
+ dstIndex := dstIndex - bytesPerRow.
].
data4 := tmp.
@@ -295,7 +302,7 @@
data := ByteArray new:(width * height).
data4 expandPixels:inDepth width:width height:height
- into:data mapping:nil.
+ into:data mapping:nil.
photometric := #palette.
samplesPerPixel := 1.
@@ -314,38 +321,38 @@
fileSize := inStream size.
fileSize < 16 ifTrue:[
- inStream close.
- self error:'WINREADER: short file'.
- ^ nil
+ inStream close.
+ self error:'WINREADER: short file'.
+ ^ nil
].
header := ByteArray uninitializedNew:4.
inStream nextBytes:4 into:header.
(header startsWith:#(66 77)) ifTrue:[ "BM"
- inStream position:1.
- 'WINREADER: Win3.x or OS/2 vsn 2 BM format' errorPrintNL.
- ^ self fromWindowsBMPStream
+ inStream position:1.
+ 'WINREADER: Win3.x or OS/2 vsn 2 BM format' errorPrintNL.
+ ^ self fromWindowsBMPStream
].
(header startsWith:#(66 65)) ifTrue:[ "BA"
- inStream position:1.
- 'WINREADER: OS/2 vsn 2 BA format' errorPrintNL.
- ^ self fromOS2Stream
+ inStream position:1.
+ 'WINREADER: OS/2 vsn 2 BA format' errorPrintNL.
+ ^ self fromOS2Stream
].
(header startsWith:#(73 67)) ifTrue:[ "IC"
- inStream position:1.
- 'WINREADER: OS/2 IC format' errorPrintNL.
- ^ self fromOS2Stream
+ inStream position:1.
+ 'WINREADER: OS/2 IC format' errorPrintNL.
+ ^ self fromOS2Stream
].
(header startsWith:#(80 84)) ifTrue:[ "PT"
- inStream position:1.
- 'WINREADER: OS/2 PT format' errorPrintNL.
- ^ self fromOS2Stream
+ inStream position:1.
+ 'WINREADER: OS/2 PT format' errorPrintNL.
+ ^ self fromOS2Stream
].
(header startsWith:#(0 0 1 0)) ifTrue:[
- inStream position:1.
- 'WINREADER: Win3.x ICO format' errorPrintNL.
- ^ self fromWindowsICOStream
+ inStream position:1.
+ 'WINREADER: Win3.x ICO format' errorPrintNL.
+ ^ self fromWindowsICOStream
].
self error:'WINREADER: format not supported'.
inStream close.
@@ -369,16 +376,16 @@
inStream nextBytes:16 into:header.
(header startsWith:#(73 67)) ifTrue:[
- "IC format"
- inStream nextBytes:10 into:header startingAt:17.
- width := header at:7.
- height := header at:9.
- inDepth := 2 "header at:11". "where is it"
+ "IC format"
+ inStream nextBytes:10 into:header startingAt:17.
+ width := header at:7.
+ height := header at:9.
+ inDepth := 2 "header at:11". "where is it"
] ifFalse:[
- inStream nextBytes:(8r110-16) into:header startingAt:17.
- width := header at:8r101.
- height := header at:8r103.
- inDepth := header at:8r107.
+ inStream nextBytes:(8r110-16) into:header startingAt:17.
+ width := header at:8r101.
+ height := header at:8r103.
+ inDepth := header at:8r107.
].
"read the colormap"
@@ -392,12 +399,12 @@
bMap := Array new:nColors.
srcIndex := 1.
1 to:nColors do:[:i |
- bMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- gMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
- rMap at:i put:(rawMap at:srcIndex).
- srcIndex := srcIndex + 1.
+ bMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ gMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
+ rMap at:i put:(rawMap at:srcIndex).
+ srcIndex := srcIndex + 1.
].
"read mask"
@@ -422,10 +429,10 @@
srcIndex := 1.
dstIndex := (height - 1) * bytesPerRow + 1.
1 to:height do:[:row |
- tmp replaceFrom:dstIndex to:(dstIndex + bytesPerRow - 1)
- with:data4 startingAt:srcIndex.
- srcIndex := srcIndex + bytesPerRow.
- dstIndex := dstIndex - bytesPerRow.
+ tmp replaceFrom:dstIndex to:(dstIndex + bytesPerRow - 1)
+ with:data4 startingAt:srcIndex.
+ srcIndex := srcIndex + bytesPerRow.
+ dstIndex := dstIndex - bytesPerRow.
].
data4 := tmp.
@@ -433,7 +440,7 @@
data := ByteArray new:(width * height).
data4 expandPixels:inDepth width:width height:height
- into:data mapping:nil.
+ into:data mapping:nil.
photometric := #palette.
samplesPerPixel := 1.
--- a/XBMReader.st Mon Oct 10 03:32:51 1994 +0100
+++ b/XBMReader.st Mon Oct 10 03:34:22 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1992 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -11,17 +11,17 @@
"
ImageReader subclass:#XBMReader
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
XBMReader comment:'
COPYRIGHT (c) 1992 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libview2/XBMReader.st,v 1.7 1994-08-05 01:16:28 claus Exp $
+$Header: /cvs/stx/stx/libview2/XBMReader.st,v 1.8 1994-10-10 02:34:18 claus Exp $
'!
!XBMReader class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1992 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/XBMReader.st,v 1.7 1994-08-05 01:16:28 claus Exp $
+$Header: /cvs/stx/stx/libview2/XBMReader.st,v 1.8 1994-10-10 02:34:18 claus Exp $
"
!
@@ -56,6 +56,12 @@
"
! !
+!XBMReader class methodsFor:'initialization'!
+
+initialize
+ Image fileFormats at:'.xbm' put:self.
+! !
+
!XBMReader methodsFor:'writing to file'!
save:image onFile:aFileName
@@ -65,8 +71,8 @@
outStream := FileStream newFileNamed:aFileName.
outStream isNil ifTrue:[
- 'create error' errorPrintNL.
- ^ nil
+ 'create error' errorPrintNL.
+ ^ nil
].
width := image width.
@@ -79,9 +85,9 @@
((samplesPerPixel ~~ 1)
or:[((bitsPerSample at:1) ~~ 1)
or:[(photometric ~~ #blackIs0) and:[photometric ~~ #whiteIs0]]]) ifTrue:[
- self error:'can only save Depth1Images'.
- outStream close.
- ^ nil.
+ self error:'can only save Depth1Images'.
+ outStream close.
+ ^ nil.
].
outStream nextPutAll: '#define xbm_width '.
@@ -99,13 +105,13 @@
srcIndex := 1.
height timesRepeat:[
- rowBytes timesRepeat:[
- outStream nextPutAll: '0x'.
- bits := data at:srcIndex. srcIndex := srcIndex + 1.
- (reverseBits at:(bits + 1)) printOn:outStream radix:16.
- outStream nextPutAll: ', '.
- ].
- outStream cr
+ rowBytes timesRepeat:[
+ outStream nextPutAll: '0x'.
+ bits := data at:srcIndex. srcIndex := srcIndex + 1.
+ (reverseBits at:(bits + 1)) printOn:outStream radix:16.
+ outStream nextPutAll: ', '.
+ ].
+ outStream cr
].
outStream nextPutAll: '};'; cr.
outStream close
@@ -125,25 +131,25 @@
line := inStream nextLine.
line isNil ifTrue:[
- inStream close.
- ^ false
+ inStream close.
+ ^ false
].
[line startsWith:'#'] whileFalse:[
- line := inStream nextLine.
- line isNil ifTrue:[
- inStream close.
- ^ false
- ]
+ line := inStream nextLine.
+ line isNil ifTrue:[
+ inStream close.
+ ^ false
+ ]
].
index1 := line indexOf:(Character space).
index2 := line indexOf:(Character space) startingAt:(index1 + 1).
(index2 == 0) ifTrue:[
- inStream close.
- ^ false
+ inStream close.
+ ^ false
].
keyword := line copyFrom:index1 to:(index2 - 1).
(keyword endsWith:'_width') ifFalse:[
- ^ false
+ ^ false
].
inStream close.
^ true
@@ -166,31 +172,31 @@
line := inStream nextLine.
line isNil ifTrue:[
- inStream close.
- ^ nil
+ inStream close.
+ ^ nil
].
[line startsWith:'#'] whileFalse:[
- line := inStream nextLine
+ line := inStream nextLine
].
(line startsWith:'#define') ifFalse:[
- 'format error (expected #define)' errorPrintNL.
- inStream close.
- ^ nil
+ 'format error (expected #define)' errorPrintNL.
+ inStream close.
+ ^ nil
].
index := line indexOf:(Character space).
index := line indexOf:(Character space) startingAt:(index + 1).
(index == 0) ifTrue:[
- 'format error' errorPrintNL.
- inStream close.
- ^ nil
+ 'format error' errorPrintNL.
+ inStream close.
+ ^ nil
].
((line copyTo:index - 1) endsWith:'width') ifFalse:[
- 'format error (expected width)' errorPrintNL.
- inStream close.
- ^ nil
+ 'format error (expected width)' errorPrintNL.
+ inStream close.
+ ^ nil
].
line := line copyFrom:(index + 1).
width := Number readFromString:line.
@@ -199,21 +205,21 @@
index := line indexOf:(Character space).
index := line indexOf:(Character space) startingAt:(index + 1).
(index == 0) ifTrue:[
- 'format error' errorPrintNL.
- inStream close.
- ^ nil
+ 'format error' errorPrintNL.
+ inStream close.
+ ^ nil
].
((line copyTo:index - 1) endsWith:'height') ifFalse:[
- 'format error (expected height)' errorPrintNL.
- inStream close.
- ^ nil
+ 'format error (expected height)' errorPrintNL.
+ inStream close.
+ ^ nil
].
line := line copyFrom:(index + 1).
height := Number readFromString:line.
bytesPerRow := width // 8.
((width \\ 8) ~~ 0) ifTrue:[
- bytesPerRow := bytesPerRow + 1
+ bytesPerRow := bytesPerRow + 1
].
reverseBits := self class reverseBits.
@@ -223,25 +229,25 @@
line := inStream nextLine.
[line startsWith:'#'] whileTrue:[
- line := inStream nextLine
+ line := inStream nextLine
].
line := inStream nextLine.
[line notNil] whileTrue:[
- index := 1.
- [index ~~ 0] whileTrue:[
- index := line indexOf:$x startingAt:index.
- (index ~~ 0) ifTrue:[
- index := index + 1.
- hi := (line at:index) digitValue.
- index := index + 1.
- lo := (line at:index) digitValue.
- val := (hi bitShift:4) bitOr:lo.
- data at:dstIndex put:(reverseBits at:(val + 1)).
- dstIndex := dstIndex + 1
- ]
- ].
- line := inStream nextLine
+ index := 1.
+ [index ~~ 0] whileTrue:[
+ index := line indexOf:$x startingAt:index.
+ (index ~~ 0) ifTrue:[
+ index := index + 1.
+ hi := (line at:index) digitValue.
+ index := index + 1.
+ lo := (line at:index) digitValue.
+ val := (hi bitShift:4) bitOr:lo.
+ data at:dstIndex put:(reverseBits at:(val + 1)).
+ dstIndex := dstIndex + 1
+ ]
+ ].
+ line := inStream nextLine
].
photometric := #whiteIs0.
samplesPerPixel := 1.
--- a/XPMReader.st Mon Oct 10 03:32:51 1994 +0100
+++ b/XPMReader.st Mon Oct 10 03:34:22 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1994 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -11,17 +11,17 @@
"
ImageReader subclass:#XPMReader
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Graphics-Support'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
!
XPMReader comment:'
COPYRIGHT (c) 1994 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libview2/XPMReader.st,v 1.2 1994-08-05 01:16:30 claus Exp $
+$Header: /cvs/stx/stx/libview2/XPMReader.st,v 1.3 1994-10-10 02:34:22 claus Exp $
'!
!XPMReader class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1994 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview2/XPMReader.st,v 1.2 1994-08-05 01:16:30 claus Exp $
+$Header: /cvs/stx/stx/libview2/XPMReader.st,v 1.3 1994-10-10 02:34:22 claus Exp $
"
!
@@ -53,19 +53,25 @@
of them). The code here is a hack - it may not work for all images (it works
for the testfiles I got here).
Limitations:
- only reads the full-color specification, ignoring monochrome
- and greyscale info.
+ only reads the full-color specification, ignoring monochrome
+ and greyscale info.
- Can only handle single-character index.
+ Can only handle single-character index.
- Does not (currently) handle none-colors (i.e. for image-masks).
+ Does not (currently) handle none-colors (i.e. for image-masks).
- Save not supported
+ Save not supported
Suggestions: adapt & use the XPM library here.
"
! !
+!XPMReader class methodsFor:'initialization'!
+
+initialize
+ Image fileFormats at:'.xpm' put:self.
+! !
+
!XPMReader class methodsFor:'testing'!
isValidImageFile:aFileName
@@ -98,13 +104,13 @@
|s|
aStream peek == $# ifTrue:[
- aStream next.
- s := '#'.
+ aStream next.
+ s := '#'.
] ifFalse:[
- s := ''.
+ s := ''.
].
- [aStream peek isAlphaNumeric] whileTrue:[
- s := s copyWith:aStream next
+ [aStream peek isLetterOrDigit] whileTrue:[
+ s := s copyWith:aStream next
].
^ s
!
@@ -121,34 +127,34 @@
inStream := self class streamReadingFile:aFileName.
inStream isNil ifTrue:[
- 'XPM: file open error' errorPrintNL.
- ^ nil
+ 'XPM: file open error' errorPrintNL.
+ ^ nil
].
line := inStream nextLine.
(line notNil and:[line startsWith:'/* XPM']) ifFalse:[
- 'XPM: format error (expected XPM)' errorPrintNL.
- inStream close.
- ^ nil
+ 'XPM: format error (expected XPM)' errorPrintNL.
+ inStream close.
+ ^ nil
].
line := inStream nextLine.
[line notNil and:[line startsWith:'/*']] whileTrue:[
- line := inStream nextLine.
+ line := inStream nextLine.
].
(line notNil and:[line startsWith:'static char']) ifFalse:[
- 'XPM: format error (expected static char)' errorPrintNL.
- inStream close.
- ^ nil
+ 'XPM: format error (expected static char)' errorPrintNL.
+ inStream close.
+ ^ nil
].
line := inStream nextLine.
[line notNil and:[line startsWith:'/*']] whileTrue:[
- line := inStream nextLine.
+ line := inStream nextLine.
].
(line notNil and:[line startsWith:'"']) ifFalse:[
- 'XPM: format error (expected "ww hh nn mm)' errorPrintNL.
- inStream close.
- ^ nil
+ 'XPM: format error (expected "ww hh nn mm)' errorPrintNL.
+ inStream close.
+ ^ nil
].
s := ReadStream on:line.
s next. "skip quote"
@@ -157,8 +163,8 @@
colorMapSize := Integer readFrom:s.
charsPerPixel := Integer readFrom:s.
charsPerPixel ~~ 1 ifTrue:[
- 'XPM: can only handle single-character xpm-files' errorPrintNL.
- ^ nil
+ 'XPM: can only handle single-character xpm-files' errorPrintNL.
+ ^ nil
].
xlation := Array new:256.
@@ -168,85 +174,85 @@
colorMap := Array with:redMap with:greenMap with:blueMap.
1 to:colorMapSize do:[:colorIndex |
- |index line color|
+ |index line color|
- line := inStream nextLine.
- [line notNil and:[line startsWith:'/*']] whileTrue:[
- line := inStream nextLine.
- ].
- (line notNil and:[line startsWith:'"']) ifFalse:[
- 'XPM: format error (expected color spec)' errorPrintNL.
- inStream close.
- ^ nil
- ].
+ line := inStream nextLine.
+ [line notNil and:[line startsWith:'/*']] whileTrue:[
+ line := inStream nextLine.
+ ].
+ (line notNil and:[line startsWith:'"']) ifFalse:[
+ 'XPM: format error (expected color spec)' errorPrintNL.
+ inStream close.
+ ^ nil
+ ].
- s := ReadStream on:line.
- s next. "skip quote"
- index := s next asciiValue.
- xlation at:index put:colorIndex - 1.
+ s := ReadStream on:line.
+ s next. "skip quote"
+ index := s next asciiValue.
+ xlation at:index put:colorIndex - 1.
- lineDone := false.
- [lineDone] whileFalse:[
- s skipSeparators.
- char := s peek.
- char == $" ifTrue:[
- lineDone := true
- ] ifFalse:[
- char == $s ifTrue:[
- "
- symbolic name
- "
- s next.
- s skipSeparators.
- s nextWord.
- s skipSeparators.
- ] ifFalse:[
- char == $m ifTrue:[
- "
- monochrome data
- "
- s next.
- s skipSeparators.
- s nextWord.
- s skipSeparators.
- ] ifFalse:[
- (char == $g) ifTrue:[
- "
- greyscale data
- "
- s next.
- s peek == 4 ifTrue:[s next].
- s skipSeparators.
- s nextWord.
- s skipSeparators.
- ] ifFalse:[
- (char == $c) ifTrue:[
- "
- color data
- "
- s next.
- s skipSeparators.
- colorName := self colorNameFrom:s.
- s skipSeparators.
- ] ifFalse:[
- 'XPM: format error (expected ''c'',''m'',''g'' or ''s'')' errorPrintNL.
- inStream close.
- ^ nil
- ].
- ]
- ]
- ]
- ].
- ].
- ((colorName = 'none') or:[colorName = 'None']) ifTrue:[
- "mhmh must add mask to Image-instances soon ..."
- color := Color white
- ] ifFalse:[
- color := Color name:colorName.
- ].
- redMap at:colorIndex put:(color red * 255 // 100).
- greenMap at:colorIndex put:(color green * 255 // 100).
- blueMap at:colorIndex put:(color blue * 255 // 100).
+ lineDone := false.
+ [lineDone] whileFalse:[
+ s skipSeparators.
+ char := s peek.
+ char == $" ifTrue:[
+ lineDone := true
+ ] ifFalse:[
+ char == $s ifTrue:[
+ "
+ symbolic name
+ "
+ s next.
+ s skipSeparators.
+ s nextWord.
+ s skipSeparators.
+ ] ifFalse:[
+ char == $m ifTrue:[
+ "
+ monochrome data
+ "
+ s next.
+ s skipSeparators.
+ s nextWord.
+ s skipSeparators.
+ ] ifFalse:[
+ (char == $g) ifTrue:[
+ "
+ greyscale data
+ "
+ s next.
+ s peek == 4 ifTrue:[s next].
+ s skipSeparators.
+ s nextWord.
+ s skipSeparators.
+ ] ifFalse:[
+ (char == $c) ifTrue:[
+ "
+ color data
+ "
+ s next.
+ s skipSeparators.
+ colorName := self colorNameFrom:s.
+ s skipSeparators.
+ ] ifFalse:[
+ 'XPM: format error (expected ''c'',''m'',''g'' or ''s'')' errorPrintNL.
+ inStream close.
+ ^ nil
+ ].
+ ]
+ ]
+ ]
+ ].
+ ].
+ ((colorName = 'none') or:[colorName = 'None']) ifTrue:[
+ "mhmh must add mask to Image-instances soon ..."
+ color := Color white
+ ] ifFalse:[
+ color := Color name:colorName.
+ ].
+ redMap at:colorIndex put:(color red * 255 // 100).
+ greenMap at:colorIndex put:(color green * 255 // 100).
+ blueMap at:colorIndex put:(color blue * 255 // 100).
].
"actually, could make it an image with less depth most of the time ..."
@@ -259,24 +265,24 @@
dstIndex := 1.
1 to:height do:[:row |
- line := inStream nextLine withoutSpaces.
- [line notNil and:[line startsWith:'/*']] whileTrue:[
- line := inStream nextLine withoutSpaces.
- ].
- (line notNil and:[line startsWith:'"']) ifFalse:[
- 'XPM: format error (expected pixels)' errorPrintNL.
- inStream close.
- ^ nil
- ].
- srcIndex := 2.
- 1 to: width do:[:col |
- |char|
+ line := inStream nextLine withoutSpaces.
+ [line notNil and:[line startsWith:'/*']] whileTrue:[
+ line := inStream nextLine withoutSpaces.
+ ].
+ (line notNil and:[line startsWith:'"']) ifFalse:[
+ 'XPM: format error (expected pixels)' errorPrintNL.
+ inStream close.
+ ^ nil
+ ].
+ srcIndex := 2.
+ 1 to: width do:[:col |
+ |char|
- char := line at:srcIndex.
- data at:dstIndex put:(xlation at:char asciiValue).
- srcIndex := srcIndex + 1.
- dstIndex := dstIndex + 1
- ]
+ char := line at:srcIndex.
+ data at:dstIndex put:(xlation at:char asciiValue).
+ srcIndex := srcIndex + 1.
+ dstIndex := dstIndex + 1
+ ]
].
photometric := #palette.