PICTReader.st
changeset 1807 aa6be4550ac7
parent 1806 69e71e3497c0
child 1808 d230c22d908e
--- a/PICTReader.st	Mon Sep 01 17:07:43 2003 +0200
+++ b/PICTReader.st	Mon Sep 01 18:52:02 2003 +0200
@@ -40,10 +40,11 @@
 
 documentation
 "
-    this class provides methods for loading Sun Raster and
-    Sun Icon file images.
+    this class will eventually provide fnctionality for loading and storing
+    Apple PICT files. (QuickTime).
 
-    No image writing is implemented.
+    WARNING: this is a first sceletton, ported from the AidaWeb PICTReader.
+    It is VERY incomplete.
 
     [See also:]
         Image Form Icon
@@ -55,6 +56,56 @@
 
 examples
 "
+  PICTReader fromFile:'/usr/lib/qt/examples/picture/car_orig.pic'
+
+
+
+  example7 --- Version 2 PICTure ---
+
+    | array stream image |
+    array := #(
+        16r0078
+        16r0000 16r0000 16r006C 16r00A8
+        16r0011
+        16r02FF
+        16r0C00
+                16rFFFE
+                16r0000
+                16r0048 16r0000
+                16r0048 16r0000
+                16r0002 16r0002 16r006E 16r00AA
+                16r0000
+        16r001E
+        16r0001
+                16r000A
+                16r0002 16r0002 16r006E 16r00AA
+        16r000A
+                16r77DD 16r77DD 16r77DD 16r77DD
+        16r0034
+                16r0002 16r0002 16r006E 16r00AA
+        16r000A
+                16r8822 16r8822 16r8822 16r8822
+        16r005C
+        16r0008
+                16r0008
+        16r0071
+                16r001A
+                16r0002 16r0002 16r006E 16r00AA
+                16r006E 16r0002 16r0002 16r0054 16r006E 16r00AA 16r006E 16r0002
+        16r00FF
+    ).
+
+    stream := WriteStream on: (ByteArray new: array size * 2 + 512).
+    512 timesRepeat:[ stream nextPut: 0].
+    array do:
+        [:n | 
+            stream nextPut: ((n bitAnd:16rFF00) bitShift: -8).
+            stream nextPut: (n bitAnd: 16r00FF)
+        ].
+    image := PICTReader fromStream: (ReadStream on: stream contents).
+    image
+
+
   example8
   --- Version 1 PICTure ---
 
@@ -80,6 +131,7 @@
             16r00 16r6E 16r00 16r02 16r00 16r02 16r00 16r54 16r00 16r6E 16r00 16rAA 16r00 16r6E 16r00 16r02
     16rFF
     ].
+    array := (ByteArray new:512) , array.
     image := PICTReader fromStream: (ReadStream on: array).
 "
 ! !
@@ -332,6 +384,67 @@
         ^Opcodes
 ! !
 
+!PICTReader class methodsFor:'opcodes'!
+
+opcodeAt: opcode 
+        "PictImageStream opcodeAt: 16r8201."
+
+        | key value string |
+
+        Opcodes isNil ifTrue:[
+            self initializeOpcodes
+        ].
+
+        (Opcodes includesKey: opcode)
+                ifTrue: [^Opcodes at: opcode].
+
+        string := opcode printStringRadix: 16.
+        string := string leftPaddedTo:4 with:$0.   "/ 4 - string size timesRepeat: [string := '0' , string]. "
+
+        key := 'Apple' , string.
+        (16r00B0 <= opcode and: [opcode <= 16r00CF])
+                ifTrue: 
+                        [value := 0.
+                        ^key -> value].
+        (16r00D0 <= opcode and: [opcode <= 16r00FE])
+                ifTrue: 
+                        [value := '4 + data length'.
+                        ^key -> value].
+        (16r0100 <= opcode and: [opcode <= 16r01FF])
+                ifTrue: 
+                        [value := 2.
+                        ^key -> value].
+        (16r0200 <= opcode and: [opcode <= 16r02FE])
+                ifTrue: 
+                        [value := 4.
+                        ^key -> value].
+        (16r0300 <= opcode and: [opcode <= 16r0BFF])
+                ifTrue: 
+                        [value := 22.
+                        ^key -> value].
+        (16r0C01 <= opcode and: [opcode <= 16r7EFF])
+                ifTrue: 
+                        [value := 24.
+                        ^key -> value].
+        (16r7F00 <= opcode and: [opcode <= 16r7FFF])
+                ifTrue: 
+                        [value := 254.
+                        ^key -> value].
+        (16r8000 <= opcode and: [opcode <= 16r80FF])
+                ifTrue: 
+                        [value := 0.
+                        ^key -> value].
+        (16r8100 <= opcode and: [opcode <= 16r81FF])
+                ifTrue: 
+                        [value := '4 + data length'.
+                        ^key -> value].
+        (16r8201 <= opcode and: [opcode <= 16rFFFF])
+                ifTrue: 
+                        [value := '4 + data length'.
+                        ^key -> value].
+        ^nil
+! !
+
 !PICTReader class methodsFor:'testing'!
 
 isValidImageFile:aFileName
@@ -390,15 +503,19 @@
 !PICTReader methodsFor:'commands'!
 
 xBitsRect
+        self debug:[ Transcript show:'xBitsRect'; cr ].
         ^self xPackBitsRect
 !
 
 xBitsRgn
+        self debug:[ Transcript show:'xBitsRgn'; cr ].
         ^self xPackBitsRgn
 !
 
 xDHDVText
         | dh dv count string |
+        self debug:[ Transcript show:'xDHDVText'; cr ].
+
         dh := self next.
         dv := self next.
         count := self next.
@@ -418,6 +535,9 @@
 
 xDHText
         | dh count string |
+
+        self debug:[ Transcript show:'xDHText'; cr ].
+
         dh := self next.
         count := self next.
         string := (self next: count) asString.
@@ -434,6 +554,9 @@
 
 xDVText
         | dv count string |
+
+        self debug:[ Transcript show:'xDVText'; cr ].
+
         dv := self next.
         count := self next.
         string := (self next: count) asString.
@@ -450,6 +573,9 @@
 
 xDirectBitsRect
         | record |
+
+        self debug:[ Transcript show:'xDirectBitsRect'; cr ].
+
         record := self readDirectPixMap: false.
         self debug: [Transcript space; show: record printString].
         imageSequence add: record.
@@ -462,6 +588,9 @@
 
 xFontName
         | dataLength fontId nameLength fontName |
+
+        self debug:[ Transcript show:'xFontName'; cr ].
+
         dataLength := self nextWord.
         fontId := self nextWord.
         nameLength := self next.
@@ -481,6 +610,9 @@
 
 xLongComment
         | kind size bytes aStream char |
+
+        self debug:[ Transcript show:'xLongComment'; cr ].
+
         kind := self nextWord.
         size := self nextWord.
         bytes := self next: size.
@@ -506,6 +638,9 @@
 
 xLongText
         | point count string |
+
+        self debug:[ Transcript show:'xLongText'; cr ].
+
         point := self readPoint.
         count := self next.
         string := (self next: count) asString.
@@ -522,6 +657,9 @@
 
 xPackBitsRect
         | position word record |
+
+        self debug:[ Transcript show:'xPackBitsRect'; cr ].
+
         position := self position.
         word := self nextWord.
         self position: position.
@@ -536,6 +674,9 @@
 
 xPackBitsRgn
         | position word record |
+
+        self debug:[ Transcript show:'xPackBitsRgn'; cr ].
+
         position := self position.
         word := self nextWord.
         self position: position.
@@ -548,6 +689,12 @@
         ^record
 ! !
 
+!PICTReader methodsFor:'debugging'!
+
+debug: aBlock
+    aBlock value
+! !
+
 !PICTReader methodsFor:'decoding'!
 
 readBitData
@@ -715,7 +862,7 @@
         | anImage maskRgn anArray |
 
         baseAddr := self nextLong.
-        rowBytes := self nextWord bitAnd: '16r3FFF' asNumber.
+        rowBytes := self nextWord bitAnd: 16r3FFF.
         bounds := self readRect.
         pmVersion := self nextWord.
         packType := self nextWord.
@@ -765,11 +912,11 @@
         picFrame := self readRect.
         position := self position.
         byte := self next.
-        byte = '16r11' asNumber
+        byte = 16r11
                 ifTrue: [picVersion := self next]
                 ifFalse: 
                         [byte := self next.
-                        byte = '16r11' asNumber
+                        byte = 16r11
                                 ifTrue: 
                                         [picVersion := self next.
                                         self next]
@@ -799,7 +946,7 @@
 
 readPixMap: isMaskRgn 
         | pixData aPalette anImage pad maskRgn anArray |
-        rowBytes := self nextWord bitAnd: '16r3FFF' asNumber.
+        rowBytes := self nextWord bitAnd: 16r3FFF.
         bounds := self readRect.
         pmVersion := self nextWord.
         packType := self nextWord.
@@ -860,10 +1007,10 @@
         | length bytes |
         length := self nextWord.
         bytes := self next: length - 2.
-        self
+        " self
                 debug: 
                         [Transcript space; show: length printString.
-                        Transcript space; show: bytes printString].
+                        Transcript space; show: bytes printString]. "
         ^Array with: length with: bytes
 !
 
@@ -881,10 +1028,9 @@
         | length bytes |
         length := self nextWord.
         bytes := self next: length - 2.
-        self
-                debug: 
-                        [Transcript space; show: length printString.
-                        Transcript space; show: bytes printString].
+        " self debug: 
+                [Transcript space; show: length printString.
+                Transcript space; show: bytes printString]. "
         ^Array with: length with: bytes
 ! !
 
@@ -980,14 +1126,14 @@
                                                 blueShift: 0
                                                 blueMask: 255)
                                         renderedBy: ErrorDiffusion new"].
-        baseAddr := '16r000000FF' asNumber.
+        baseAddr := 16r000000FF.
         rowBytes := anImage width * 32 + 7 // 8.
         bounds := anImage bounds.
         pmVersion := 0.
         packType := 4.
         packSize := 0.
-        hRes := '16r00480000' asNumber.
-        vRes := '16r00480000' asNumber.
+        hRes := 16r00480000.
+        vRes := 16r00480000.
         pixelType := 16.
         pixelSize := 32.
         cmpCount := 3.
@@ -998,7 +1144,7 @@
         srcRect := anImage bounds.
         dstRect := anImage bounds.
         mode := 64.
-        endOpcode := '16r00FF' asNumber.
+        endOpcode := 16r00FF.
         self writeImage24: anImage.
         self writeOpcode: endOpcode.
         ^anImage
@@ -1022,7 +1168,7 @@
 
 writeBits24: bits 
         | currentOpecode |
-        currentOpecode := '16r009A' asNumber.
+        currentOpecode := 16r009A.
         self writeOpcode: currentOpecode.
         self nextLongPut: baseAddr.
         self nextWordPut: rowBytes + (1 bitShift: 15).
@@ -1047,8 +1193,8 @@
 
 writeBits: bits palette: palette 
         rowBytes < 8
-                ifTrue: [currentOpcode := '16r90' asNumber]
-                ifFalse: [currentOpcode := '16r0098' asNumber].
+                ifTrue: [currentOpcode := 16r90]
+                ifFalse: [currentOpcode := 16r0098].
         picVersion = 1
                 ifTrue: 
                         [self writeOpcode: currentOpcode.
@@ -1100,8 +1246,8 @@
 
 writeClip: aRectangle 
         picVersion = 1
-                ifTrue: [self writeOpcode: '16r01' asNumber]
-                ifFalse: [self writeOpcode: '16r0001' asNumber].
+                ifTrue: [self writeOpcode: 16r01]
+                ifFalse: [self writeOpcode: 16r0001].
         self nextWordPut: 10.
         self writeRect: aRectangle
 !
@@ -1200,16 +1346,20 @@
 !PICTReader methodsFor:'interpreting'!
 
 fixedOpcode: opcodeName additionalData: additionalData 
-        | bytes |
-        self debug: [Transcript space; show: opcodeName].
-        bytes := self next: additionalData.
-        self debug: [Transcript space; show: bytes printString]
+    | bytes |
+
+    " self debug: [Transcript space; show: opcodeName]. "
+    bytes := self next: additionalData.
+    " self debug: [Transcript space; show: bytes printString] "
 !
 
 interpretOpcode: association 
         | opcodeName additionalData |
         opcodeName := association key.
         additionalData := association value.
+
+        self debug:[ Transcript show: 'op:'; show:opcodeName; show:' ['; show:additionalData; show:']'; cr ].
+
         additionalData isString
                 ifTrue: [self variableOpcode: opcodeName additionalData: additionalData]
                 ifFalse: [self fixedOpcode: opcodeName additionalData: additionalData]
@@ -1217,11 +1367,9 @@
 
 nextOpcode
         | association |
-        self
-                debug: 
-                        [Transcript cr.
-                        Transcript show: (self hexString4: self position).
-                        Transcript show: ':'].
+        " self debug: [Transcript cr.
+                     Transcript show: (self hexString4: self position).
+                     Transcript show: ':']. "
         picVersion = 1
                 ifTrue: [currentOpcode := self next]
                 ifFalse: 
@@ -1235,11 +1383,13 @@
 
 variableOpcode: opcodeName additionalData: additionalData 
         | aSymbol |
-        self debug: [Transcript space; show: opcodeName].
+
+        " self debug: [Transcript space; show: opcodeName]. "
         additionalData = 'Polygon size' ifTrue: [^self readPolygon].
         additionalData = 'Region size' ifTrue: [^self readRegion].
         additionalData = '2 + data length' ifTrue: [^self readDataLength2].
         additionalData = '4 + data length' ifTrue: [^self readDataLength4].
+
         (opcodeName copyFrom: 1 to: ('Apple' size min: opcodeName size))
                 = 'Apple' ifTrue: [^self errorUnexpectedOpcode].
         aSymbol := ((String with: $x with: opcodeName first asUppercase)
@@ -1511,6 +1661,8 @@
 
     |endOpcode|
 
+    ^ self fileFormatError:'Sorry - PICT image implementation is incomplete'.
+
     inStream := aStream.
     aStream binary.
 
@@ -1523,7 +1675,9 @@
     [currentOpcode = endOpcode]
             whileFalse: [self nextOpcode].
     imageSequence isEmpty ifTrue: [^nil].
-    imageSequence size = 1 ifTrue: [^ imageSequence first first].
+    imageSequence size = 1 ifTrue: [
+        ^ imageSequence first first
+    ].
     ^ self mergeImages
 
     "
@@ -1533,10 +1687,83 @@
     "
 ! !
 
+!PICTReader methodsFor:'support-IO'!
+
+next
+    ^ inStream nextByte
+!
+
+next:numBytes 
+        ^ inStream next:numBytes
+!
+
+nextLong
+"/    ^ (inStream next bitShift: 24)
+"/            + (inStream next bitShift: 16) + (inStream next bitShift: 8) + inStream next
+    ^ inStream nextUnsignedLongMSB:true
+!
+
+nextLongPut:a32BitW 
+"/    outStream nextPut: ((a32BitW bitShift: -24)
+"/                    bitAnd: 255).
+"/    outStream nextPut: ((a32BitW bitShift: -16)
+"/                    bitAnd: 255).
+"/    outStream nextPut: ((a32BitW bitShift: -8)
+"/                    bitAnd: 255).
+"/    outStream nextPut: (a32BitW bitAnd: 255).
+    outStream nextPutLong:a32BitW MSB:true.
+    ^a32BitW
+!
+
+nextPut:aByte 
+    outStream nextPut:aByte
+!
+
+nextWord
+    ^ inStream nextUnsignedShortMSB:true
+!
+
+nextWordPut:a16BitW 
+"/    outStream nextPut: ((a16BitW bitShift: -8)
+"/                    bitAnd: 255).
+"/    outStream nextPut: (a16BitW bitAnd: 255).
+    outStream nextPutShort:a16BitW MSB:true.
+    ^a16BitW
+!
+
+position
+    ^ inStream position
+!
+
+position:arg 
+    inStream position:arg
+!
+
+size
+    self halt.
+    ^ outStream size
+!
+
+skip: anInteger 
+self halt.
+    ^ inStream skip: anInteger
+!
+
+space
+    ^ outStream space
+!
+
+tab
+    ^ outStream tab
+! !
+
 !PICTReader methodsFor:'writing'!
 
 nextPutImage: anImage 
         | endOpcode |
+
+    ^ self fileFormatError:'Sorry - PICT image implementation is incomplete'.
+
 "/        (anImage isKindOf: Image) not ifTrue: [^self errorCanNotWrite].
 "/        ((imageStream isKindOf: ExternalStream)
 "/                or: [(imageStream respondsTo: #stream)
@@ -1578,7 +1805,7 @@
 !PICTReader class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview2/PICTReader.st,v 1.2 2003-09-01 15:07:43 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview2/PICTReader.st,v 1.3 2003-09-01 16:52:02 cg Exp $'
 ! !
 
 PICTReader initialize!