"{ Package: 'stx:libview2' }"

ImageReader subclass:#PICTReader
	instanceVariableNames:'currentOpcode rowBytes bounds srcRect dstRect mode ctSeed ctFlags
		ctSize ctTable packType baseAddr pmVersion packSize hRes vRes
		pixelType pixelSize cmpCount cmpSize planeBytes pmTable
		pmReserved picSize picFrame picVersion'
	classVariableNames:'Opcodes'
	poolDictionaries:''
	category:'Graphics-Images-Readers'
!

Object subclass:#PICTFrame
	instanceVariableNames:'image sourceRectangle destinationRectangle mode maskRegion'
	classVariableNames:''
	poolDictionaries:''
	privateIn:PICTReader
!

!PICTReader class methodsFor:'documentation'!

documentation
"
    this class will eventually provide fnctionality for loading and storing
    Apple PICT files. (QuickTime).

    WARNING: this is a first sceletton, ported from the AidaWeb PICTReader.
    The implementation is VERY incomplete - it is provided here to provide a starting
    point for porters.

    For now, it does read a few sample images from the GFF books example CD.

    [See also:]
        Image Form Icon
        BlitImageReader FaceReader JPEGReader GIFReader PBMReader PCXReader 
        ST80FormReader TargaReader TIFFReader WindowsIconReader 
        XBMReader XPMReader XWDReader 
"
!

examples
"
  PICTReader fromFile:'/unsaved2/stefan/nil/home/stefan/dos/winword/shared/ms.pct'
  PICTReader fromFile:'/phys/exept/tmp/pict/BLK.PCT'
  PICTReader fromFile:'/phys/exept/tmp/pict/BLU.PCT'
  PICTReader fromFile:'/phys/exept/tmp/pict/GRN.PCT'
  PICTReader fromFile:'/phys/exept/tmp/pict/RED.PCT'
  PICTReader fromFile:'/phys/exept/tmp/pict/WHT.PCT'
  PICTReader fromFile:'/phys/exept/tmp/pict/YEL.PCT'
  PICTReader fromFile:'/phys/exept/tmp/pict/FLAG_B24.PCT'
  PICTReader fromFile:'/phys/exept/tmp/pict/MARBLES.PCT'
  PICTReader fromFile:'/phys/exept/tmp/pict/TRU256.PCT'
  PICTReader fromFile:'/phys/exept/tmp/pict/VENUS.PCT'


  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).
    stream next:512 put: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 ---

    | array image |
    array := #[
    16r00 16r4F
    16r00 16r02 16r00 16r02 16r00 16r6E 16r00 16rAA
    16r11
            16r01
    16r01
            16r00 16r0A
            16r00 16r02 16r00 16r02 16r00 16r6E 16r00 16rAA
    16r0A
            16r77 16rDD 16r77 16rDD 16r77 16rDD 16r77 16rDD
    16r34
            16r00 16r02 16r00 16r02 16r00 16r6E 16r00 16rAA
    16r0A
            16r88 16r22 16r88 16r22 16r88 16r22 16r88 16r22
    16r5C
    16r71
            16r00 16r1A
            16r00 16r02 16r00 16r02 16r00 16r6E 16r00 16rAA
            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).
    image
"
! !

!PICTReader class methodsFor:'initialization'!

defineOpcodes00 
        Opcodes at: 16r0000 put: ('NOP' -> 0).
        Opcodes at: 16r0001 put: ('Clip' -> 'Region size').
        Opcodes at: 16r0002 put: ('BkPat' -> 8).
        Opcodes at: 16r0003 put: ('TxFont' -> 2).
        Opcodes at: 16r0004 put: ('TxFace' -> 1).
        Opcodes at: 16r0005 put: ('TxMode' -> 2).
        Opcodes at: 16r0006 put: ('SpExtra' -> 4).
        Opcodes at: 16r0007 put: ('PnSize' -> 4).
        Opcodes at: 16r0008 put: ('PnMode' -> 2).
        Opcodes at: 16r0009 put: ('PnPat' -> 8).
        Opcodes at: 16r000A put: ('FillPat' -> 8).
        Opcodes at: 16r000B put: ('OvSize' -> 4).
        Opcodes at: 16r000C put: ('Origin' -> 4).
        Opcodes at: 16r000D put: ('TxSize' -> 2).
        Opcodes at: 16r000E put: ('FgColor' -> 4).
        Opcodes at: 16r000F put: ('BkColor' -> 4).
!

defineOpcodes01
        Opcodes at: 16r0010 put: ('TxRatio' -> 8).
        Opcodes at: 16r0011 put: ('VersionOp' -> 1).
        Opcodes at: 16r0012 put: ('BkPixPat' -> 'Variable').
        Opcodes at: 16r0013 put: ('PnPixPat' -> 'Variable').
        Opcodes at: 16r0014 put: ('FillPixPat' -> 'Variable').
        Opcodes at: 16r0015 put: ('PnLocHFrac' -> 2).
        Opcodes at: 16r0016 put: ('ChExtra' -> 2).
        Opcodes at: 16r0017 put: ('Apple0017' -> 'Not determined').
        Opcodes at: 16r0018 put: ('Apple0018' -> 'Not determined').
        Opcodes at: 16r0019 put: ('Apple0019' -> 'Not determined').
        Opcodes at: 16r001A put: ('RGBFgCol' -> 6).
        Opcodes at: 16r001B put: ('RGBBkCol' -> 6).
        Opcodes at: 16r001C put: ('HiliteMode' -> 0).
        Opcodes at: 16r001D put: ('HiliteColor' -> 6).
        Opcodes at: 16r001E put: ('DefHilite' -> 0).
        Opcodes at: 16r001F put: ('OpColor' -> 6).
!

defineOpcodes02 
        Opcodes at: 16r0020 put: ('Line' -> 8).
        Opcodes at: 16r0021 put: ('LineFrom' -> 4).
        Opcodes at: 16r0022 put: ('ShortLine' -> 6).
        Opcodes at: 16r0023 put: ('ShortLineFrom' -> 2).
        Opcodes at: 16r0024 put: ('Apple0024' -> '2 + data length').
        Opcodes at: 16r0025 put: ('Apple0025' -> '2 + data length').
        Opcodes at: 16r0026 put: ('Apple0026' -> '2 + data length').
        Opcodes at: 16r0027 put: ('Apple0027' -> '2 + data length').
        Opcodes at: 16r0028 put: ('LongText' -> '5 + text').
        Opcodes at: 16r0029 put: ('DHText' -> '2 + text').
        Opcodes at: 16r002A put: ('DVText' -> '2 + text').
        Opcodes at: 16r002B put: ('DHDVText' -> '3 + text').
        Opcodes at: 16r002C put: ('fontName' -> '5 + name length').
        Opcodes at: 16r002D put: ('lineJustify' -> 10).
        Opcodes at: 16r002E put: ('glyphState' -> 8).
        Opcodes at: 16r002F put: ('Apple002F' -> '2 + data length').
!

defineOpcodes03
        Opcodes at: 16r0030 put: ('frameRect' -> 8).
        Opcodes at: 16r0031 put: ('paintRect' -> 8).
        Opcodes at: 16r0032 put: ('eraseRect' -> 8).
        Opcodes at: 16r0033 put: ('invertRect' -> 8).
        Opcodes at: 16r0034 put: ('fillRect' -> 8).
        Opcodes at: 16r0035 put: ('Apple0035' -> 8).
        Opcodes at: 16r0036 put: ('Apple0036' -> 8).
        Opcodes at: 16r0037 put: ('Apple0037' -> 8).
        Opcodes at: 16r0038 put: ('frameSameRect' -> 0).
        Opcodes at: 16r0039 put: ('paintSameRect' -> 0).
        Opcodes at: 16r003A put: ('eraseSameRect' -> 0).
        Opcodes at: 16r003B put: ('invertSameRect' -> 0).
        Opcodes at: 16r003C put: ('fillSameRect' -> 0).
        Opcodes at: 16r003D put: ('Apple003D' -> 0).
        Opcodes at: 16r003E put: ('Apple003E' -> 0).
        Opcodes at: 16r003F put: ('Apple003F' -> 0).
!

defineOpcodes04
        Opcodes at: 16r0040 put: ('frameRRect' -> 8).
        Opcodes at: 16r0041 put: ('paintRRect' -> 8).
        Opcodes at: 16r0042 put: ('eraseRRect' -> 8).
        Opcodes at: 16r0043 put: ('invertRRect' -> 8).
        Opcodes at: 16r0044 put: ('fillRect' -> 8).
        Opcodes at: 16r0045 put: ('Apple0045' -> 8).
        Opcodes at: 16r0046 put: ('Apple0046' -> 8).
        Opcodes at: 16r0047 put: ('Apple0047' -> 8).
        Opcodes at: 16r0048 put: ('frameSameRRect' -> 0).
        Opcodes at: 16r0049 put: ('paintSameRRect' -> 0).
        Opcodes at: 16r004A put: ('eraseSameRRect' -> 0).
        Opcodes at: 16r004B put: ('invertSameRRect' -> 0).
        Opcodes at: 16r004C put: ('fillSameRRect' -> 0).
        Opcodes at: 16r004D put: ('Apple004D' -> 0).
        Opcodes at: 16r004E put: ('Apple004E' -> 0).
        Opcodes at: 16r004F put: ('Apple004F' -> 0).
!

defineOpcodes05
        Opcodes at: 16r0050 put: ('frameOval' -> 8).
        Opcodes at: 16r0051 put: ('paintOval' -> 8).
        Opcodes at: 16r0052 put: ('eraseOval' -> 8).
        Opcodes at: 16r0053 put: ('invertOval' -> 8).
        Opcodes at: 16r0054 put: ('fillRect' -> 8).
        Opcodes at: 16r0055 put: ('Apple0055' -> 8).
        Opcodes at: 16r0056 put: ('Apple0056' -> 8).
        Opcodes at: 16r0057 put: ('Apple0057' -> 8).
        Opcodes at: 16r0058 put: ('frameSameOval' -> 0).
        Opcodes at: 16r0059 put: ('paintSameOval' -> 0).
        Opcodes at: 16r005A put: ('eraseSameOval' -> 0).
        Opcodes at: 16r005B put: ('invertSameOval' -> 0).
        Opcodes at: 16r005C put: ('fillSameOval' -> 0).
        Opcodes at: 16r005D put: ('Apple005D' -> 0).
        Opcodes at: 16r005E put: ('Apple005E' -> 0).
        Opcodes at: 16r005F put: ('Apple005F' -> 0).
!

defineOpcodes06
        Opcodes at: 16r0060 put: ('frameArc' -> 12).
        Opcodes at: 16r0061 put: ('paintArc' -> 12).
        Opcodes at: 16r0062 put: ('eraseArc' -> 12).
        Opcodes at: 16r0063 put: ('invertArc' -> 12).
        Opcodes at: 16r0064 put: ('fillRect' -> 12).
        Opcodes at: 16r0065 put: ('Apple0065' -> 12).
        Opcodes at: 16r0066 put: ('Apple0066' -> 12).
        Opcodes at: 16r0067 put: ('Apple0067' -> 12).
        Opcodes at: 16r0068 put: ('frameSameArc' -> 4).
        Opcodes at: 16r0069 put: ('paintSameArc' -> 4).
        Opcodes at: 16r006A put: ('eraseSameArc' -> 4).
        Opcodes at: 16r006B put: ('invertSameArc' -> 4).
        Opcodes at: 16r006C put: ('fillSameArc' -> 4).
        Opcodes at: 16r006D put: ('Apple006D' -> 4).
        Opcodes at: 16r006E put: ('Apple006E' -> 4).
        Opcodes at: 16r006F put: ('Apple006F' -> 4).
!

defineOpcodes07
        Opcodes at: 16r0070 put: ('framePoly' -> 'Polygon size').
        Opcodes at: 16r0071 put: ('paintPoly' -> 'Polygon size').
        Opcodes at: 16r0072 put: ('erasePoly' -> 'Polygon size').
        Opcodes at: 16r0073 put: ('invertPoly' -> 'Polygon size').
        Opcodes at: 16r0074 put: ('fillRect' -> 'Polygon size').
        Opcodes at: 16r0075 put: ('Apple0075' -> 'Polygon size').
        Opcodes at: 16r0076 put: ('Apple0076' -> 'Polygon size').
        Opcodes at: 16r0077 put: ('Apple0077' -> 'Polygon size').
        Opcodes at: 16r0078 put: ('frameSamePoly' -> 0).
        Opcodes at: 16r0079 put: ('paintSamePoly' -> 0).
        Opcodes at: 16r007A put: ('eraseSamePoly' -> 0).
        Opcodes at: 16r007B put: ('invertSamePoly' -> 0).
        Opcodes at: 16r007C put: ('fillSamePoly' -> 0).
        Opcodes at: 16r007D put: ('Apple007D' -> 0).
        Opcodes at: 16r007E put: ('Apple007E' -> 0).
        Opcodes at: 16r007F put: ('Apple007F' -> 0).
!

defineOpcodes08
        Opcodes at: 16r0080 put: ('frameRgn' -> 'Region size').
        Opcodes at: 16r0081 put: ('paintRgn' -> 'Region size').
        Opcodes at: 16r0082 put: ('eraseRgn' -> 'Region size').
        Opcodes at: 16r0083 put: ('invertRgn' -> 'Region size').
        Opcodes at: 16r0084 put: ('fillRect' -> 'Region size').
        Opcodes at: 16r0085 put: ('Apple0085' -> 'Region size').
        Opcodes at: 16r0086 put: ('Apple0086' -> 'Region size').
        Opcodes at: 16r0087 put: ('Apple0087' -> 'Region size').
        Opcodes at: 16r0088 put: ('frameSameRgn' -> 0).
        Opcodes at: 16r0089 put: ('paintSameRgn' -> 0).
        Opcodes at: 16r008A put: ('eraseSameRgn' -> 0).
        Opcodes at: 16r008B put: ('invertSameRgn' -> 0).
        Opcodes at: 16r008C put: ('fillSameRgn' -> 0).
        Opcodes at: 16r008D put: ('Apple008D' -> 0).
        Opcodes at: 16r008E put: ('Apple008E' -> 0).
        Opcodes at: 16r008F put: ('Apple008F' -> 0).
!

defineOpcodes09
        Opcodes at: 16r0090 put: ('BitsRect' -> 'Variable').
        Opcodes at: 16r0091 put: ('BitsRgn' -> 'Variable').
        Opcodes at: 16r0092 put: ('Apple0092' -> '2 + data length').
        Opcodes at: 16r0093 put: ('Apple0093' -> '2 + data length').
        Opcodes at: 16r0094 put: ('Apple0094' -> '2 + data length').
        Opcodes at: 16r0095 put: ('Apple0095' -> '2 + data length').
        Opcodes at: 16r0096 put: ('Apple0096' -> '2 + data length').
        Opcodes at: 16r0097 put: ('Apple0097' -> '2 + data length').
        Opcodes at: 16r0098 put: ('PackBitsRect' -> 'Variable').
        Opcodes at: 16r0099 put: ('PackBitsRgn' -> 'Variable').
        Opcodes at: 16r009A put: ('DirectBitsRect' -> 'Variable').
        Opcodes at: 16r009B put: ('DirectBitsRegn' -> 'Variable').
        Opcodes at: 16r009C put: ('Apple009C' -> '2 + data length').
        Opcodes at: 16r009D put: ('Apple009D' -> '2 + data length').
        Opcodes at: 16r009E put: ('Apple009E' -> '2 + data length').
        Opcodes at: 16r009F put: ('Apple009F' -> '2 + data length').
!

defineOpcodes10
        Opcodes at: 16r00A0 put: ('ShortComment' -> 2).
        Opcodes at: 16r00A1 put: ('LongComment' -> '4 + data').
        Opcodes at: 16r00A2 put: ('Apple00A2' -> '2 + data length').
        Opcodes at: 16r00A3 put: ('Apple00A3' -> '2 + data length').
        Opcodes at: 16r00A4 put: ('Apple00A4' -> '2 + data length').
        Opcodes at: 16r00A5 put: ('Apple00A5' -> '2 + data length').
        Opcodes at: 16r00A6 put: ('Apple00A6' -> '2 + data length').
        Opcodes at: 16r00A7 put: ('Apple00A7' -> '2 + data length').
        Opcodes at: 16r00A8 put: ('Apple00A8' -> '2 + data length').
        Opcodes at: 16r00A9 put: ('Apple00A9' -> '2 + data length').
        Opcodes at: 16r00AA put: ('Apple00AA' -> '2 + data length').
        Opcodes at: 16r00AB put: ('Apple00AB' -> '2 + data length').
        Opcodes at: 16r00AC put: ('Apple00AC' -> '2 + data length').
        Opcodes at: 16r00AD put: ('Apple00AD' -> '2 + data length').
        Opcodes at: 16r00AE put: ('Apple00AE' -> '2 + data length').
        Opcodes at: 16r00AF put: ('Apple00AF' -> '2 + data length').
!

defineOpcodes99
        Opcodes at: 16r00FF put: ('OpEndPic' -> 0).
        Opcodes at: 16r02FF put: ('Version' -> 2).
        Opcodes at: 16r0C00 put: ('HeaderOp' -> 24).
        Opcodes at: 16r8200 put: ('CompressedQuickTime' -> '4 + data length').
        Opcodes at: 16r8201 put: ('UncompressedQuickTime' -> '4 + data length').
!

initialize
    "install myself in the Image classes fileFormat table
     for the `.pic' and '.pict' extensions."

    MIMETypes defineImageType:nil suffix:'pict' reader:self.
    MIMETypes defineImageType:nil suffix:'pic'  reader:self.

    "PictReader initialize."
!

initializeOpcodes
        "PictImageStream initializeOpcodes."

        Opcodes := IdentityDictionary new: 100.
        self defineOpcodes00.
        self defineOpcodes01.
        self defineOpcodes02.
        self defineOpcodes03.
        self defineOpcodes04.
        self defineOpcodes05.
        self defineOpcodes06.
        self defineOpcodes07.
        self defineOpcodes08.
        self defineOpcodes09.
        self defineOpcodes10.
        self defineOpcodes99.
        ^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
    "return true, if aFileName contains a sunraster image"

    |inStream nr|

    inStream := self streamReadingFile:aFileName.
    inStream isNil ifTrue:[^ false].

    "try sun raster"
    inStream binary.
    ((inStream nextWord == 16r59A6) 
    and:[inStream nextWord == 16r6A95]) ifTrue: [
	inStream close.
	^ true
    ].

    inStream isPositionable ifFalse:[^ false].

    "try sun bitmap image format"
    inStream text.
    inStream reset.

    "must start with a comment"
    inStream skipSeparators.
    inStream next ~~ $/ ifTrue:[^ false].
    inStream next ~~ $* ifTrue:[^ false].

    (inStream skipThroughAll: 'idth') isNil ifTrue: [
	inStream close.
	^ false
    ].
    inStream next; skipSeparators.
    nr := Integer readFrom: inStream.
    (nr isNil or:[nr <= 0]) ifTrue: [
	inStream close.
	^ false
    ].

    (inStream skipThroughAll: 'eight') isNil ifTrue: [
	inStream close.
	^ false
    ].
    inStream next; skipSeparators.
    nr := Integer readFrom: inStream.
    (nr isNil or:[nr <= 0]) ifTrue: [
	inStream close.
	^ false
    ].

    inStream close.
    ^ true
! !

!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.
        string := (self next: count) asString.
        self
                debug: 
                        [Transcript space; show: dh printString.
                        Transcript space; show: dv printString.
                        Transcript space; show: count printString.
                        Transcript space; show: string printString].
        ^Array
                with: dh
                with: dv
                with: count
                with: string
!

xDHText
        | dh count string |

        self debug:[ Transcript show:'xDHText'; cr ].

        dh := self next.
        count := self next.
        string := (self next: count) asString.
        self
                debug: 
                        [Transcript space; show: dh printString.
                        Transcript space; show: count printString.
                        Transcript space; show: string printString].
        ^Array
                with: dh
                with: count
                with: string
!

xDVText
        | dv count string |

        self debug:[ Transcript show:'xDVText'; cr ].

        dv := self next.
        count := self next.
        string := (self next: count) asString.
        self
                debug: 
                        [Transcript space; show: dv printString.
                        Transcript space; show: count printString.
                        Transcript space; show: string printString].
        ^Array
                with: dv
                with: count
                with: string
!

xDirectBitsRect
        | record |

        self debug:[ Transcript show:'xDirectBitsRect'; cr ].

        record := self readDirectPixMap: false.
        self debug: [Transcript space; show: record printString].
        imageSequence add: record.
        ^record
!

xDirectBitsRgn
        ^self readDirectPixMap: true
!

xFontName
        | dataLength fontId nameLength fontName |

        self debug:[ Transcript show:'xFontName'; cr ].

        dataLength := self nextWord.
        fontId := self nextWord.
        nameLength := self next.
        fontName := (self next: nameLength) asString.
        self
                debug: 
                        [Transcript space; show: dataLength printString.
                        Transcript space; show: fontId printString.
                        Transcript space; show: nameLength printString.
                        Transcript space; show: fontName printString].
        ^Array
                with: dataLength
                with: fontId
                with: nameLength
                with: fontName
!

xLongComment
        | kind size bytes aStream char |

        self debug:[ Transcript show:'xLongComment'; cr ].

        kind := self nextWord.
        size := self nextWord.
        bytes := self next: size.
        aStream := WriteStream on: (String new: bytes size).
        bytes
                do: 
                        [:byte | 
                        char := Character value: byte.
                        ((33 <= byte and: [byte <= 126])
                                or: [char = Character tab or: [char = Character space or: [char = Character cr]]])
                                ifTrue: [aStream nextPut: char]
                                ifFalse: [aStream nextPut: Character space]].
        self
                debug: 
                        [Transcript space; show: kind printString.
                        Transcript space; show: size printString.
                        Transcript space; show: aStream contents printString].
        ^Array
                with: kind
                with: size
                with: bytes
!

xLongText
        | point count string |

        self debug:[ Transcript show:'xLongText'; cr ].

        point := self readPoint.
        count := self next.
        string := (self next: count) asString.
        self
                debug: 
                        [Transcript space; show: point printString.
                        Transcript space; show: count printString.
                        Transcript space; show: string printString].
        ^Array
                with: point
                with: count
                with: string
!

xPackBitsRect
        | position word record |

        self debug:[ Transcript show:'xPackBitsRect'; cr ].

        position := self position.
        word := self nextWord.
        self position: position.
        (word bitShift: -15)
                = 1
                ifTrue: [record := self readPixMap: false]
                ifFalse: [record := self readBitMap: false].
        self debug: [Transcript space; show: record printString].
        imageSequence add: record.
        ^record
!

xPackBitsRgn
        | position word record |

        self debug:[ Transcript show:'xPackBitsRgn'; cr ].

        position := self position.
        word := self nextWord.
        self position: position.
        (word bitShift: -15)
                = 1
                ifTrue: [record := self readPixMap: true]
                ifFalse: [record := self readBitMap: true].
        self debug: [Transcript space; show: record printString].
        imageSequence add: record.
        ^record
! !

!PICTReader methodsFor:'debugging'!

debug: aBlock
    aBlock value
! !

!PICTReader methodsFor:'decoding'!

readBitData
        | bitData |
        bitData := ByteArray new: rowBytes * bounds height.
        self progress: 0.
        1 to: bounds height
                do: 
                        [:column | 
                        | start stop replacement |
                        start := column - 1 * rowBytes + 1.
                        stop := column * rowBytes.
                        replacement := self readBitRowData.
                        bitData
                                replaceBytesFrom: start
                                to: stop
                                with: replacement
                                startingAt: 1.
                        self progress: column / bounds height].
        ^bitData
!

readBitMap: isMaskRgn 
        | bitData anImage pad anArray maskRgn |
        rowBytes := self nextWord.
        bounds := self readRect.
        srcRect := self readRect.
        dstRect := self readRect.
        mode := self nextWord.
        bitData := self readBitData.
        isMaskRgn = true ifTrue: [maskRgn := self readRegion].
        pad := rowBytes * 8 - bounds width.
        pad >= 8
                ifTrue: [pad >= 16
                                ifTrue: [pad := 32]
                                ifFalse: [pad := 16]]
                ifFalse: [pad := 8].

        anImage := Image
                                extent: bounds width @ bounds height
                                depth: 1
                                palette: MappedPalette monochromeDefault
                                bits: bitData
                                pad: pad.

        " self debug: [anImage displayOn: ScheduledControllers activeController view graphicsContext]. "
"/ OLD
"/        anArray := Array
"/                    with: anImage
"/                    with: srcRect
"/                    with: dstRect
"/                    with: mode.
"/        isMaskRgn = true ifTrue: [anArray := anArray , (Array with: maskRgn)].
"/ NEW:
        anArray := PICTFrame new
                    image:anImage 
                    sourceRectangle:srcRect 
                    destinationRectangle:dstRect 
                    mode:mode.
        isMaskRgn = true ifTrue: [
            anArray maskRegion:maskRgn
        ].
        ^anArray
!

readBitRowData
        | rawData byteCount |
        rowBytes < 8
                ifTrue: [rawData := self next: rowBytes]
                ifFalse: 
                        [rowBytes > 250
                                ifTrue: [byteCount := self nextWord]
                                ifFalse: [byteCount := self next].
                        rawData := self unPackBits: (self next: byteCount)].
        ^rawData
!

readColorTable
        ctSeed := self nextLong.
        ctFlags := self nextWord.
        ctSize := self nextWord.
        ctTable := Array new: ctSize + 1.
        1 to: ctTable size
                do: 
                        [:i | 
                        | value rgb |
                        value := self nextWord.
                        value yourself.
                        rgb := self nextWord bitShift: 32.
                        rgb := rgb + (self nextWord bitShift: 16).
                        rgb := rgb + self nextWord.
                        ctTable at: i put: rgb]
!

readDataLength2
        | length bytes |
        length := self nextWord.
        bytes := self next: length.
        " self debug: [Transcript space; show: bytes printString]. "
        ^Array with: length with: bytes
!

readDataLength4
        | length bytes |
        length := self nextLong.
        bytes := self next: length.
        " self debug: [Transcript space; show: bytes printString]. "
        ^Array with: length with: bytes
!

readDirectPixData
        packType = 0 ifTrue: [^self errorSorryNotSupported].
        packType = 1 ifTrue: [^self errorSorryNotSupported].
        packType = 2 ifTrue: [^self errorSorryNotSupported].
        packType = 3 ifTrue: [^self errorSorryNotSupported].
        packType = 4 ifTrue: [^self readDirectPixData4].
        ^self errorUnexpectedPakingType
!

readDirectPixData4
        | palette image row scalingValue color index r g b |
"/        palette := FixedPalette
"/                                redShift: 16
"/                                redMask: 255
"/                                greenShift: 8
"/                                greenMask: 255
"/                                blueShift: 0
"/                                blueMask: 255.
        image := Image
                                extent: bounds width @ bounds height
                                depth: 24
                                palette: palette.
        self progress: 0.
        0 to: bounds height - 1
                do: 
                        [:y | 
                        | x |
                        x := 0.
                        row := self readDirectPixRowData.
                        r := row size // 3 * 0 + 1.
                        g := row size // 3 * 1 + 1.
                        b := row size // 3 * 2 + 1.
                        row size // 3
                                timesRepeat: 
                                        [
                                        "/ ST/X
                                        image pixelAtX:x y:y put:( ((((row at: r) bitShift:8)
                                                                    bitOr:(row at: g)) bitShift:8)
                                                                   bitOr:(row at: b)).

                                        "/ VW
"/                                        scalingValue := ColorValue scalingValue.
"/                                        color := ColorValue
"/                                                                scaledRed: (self
"/                                                                                convertValue: ((row at: r)
"/                                                                                                bitAnd: 255)
"/                                                                                from: 255
"/                                                                                to: scalingValue)
"/                                                                scaledGreen: (self
"/                                                                                convertValue: ((row at: g)
"/                                                                                                bitAnd: 255)
"/                                                                                from: 255
"/                                                                                to: scalingValue)
"/                                                                scaledBlue: (self
"/                                                                                convertValue: (row at: b)
"/                                                                                from: 255
"/                                                                                to: scalingValue).
"/                                        index := palette indexOfPaintNearest: color.
"/                                        image
"/                                                atX: x
"/                                                y: y
"/                                                put: index.
                                        r := r + 1.
                                        g := g + 1.
                                        b := b + 1.
                                        x := x + 1].
                        self progress: y / (bounds height - 1)].
        ^image
!

readDirectPixMap: isMaskRgn 
        | anImage maskRgn anArray |

        baseAddr := self nextLong.
        rowBytes := self nextWord bitAnd: 16r3FFF.
        bounds := self readRect.
        pmVersion := self nextWord.
        packType := self nextWord.
        packSize := self nextLong.
        hRes := self nextLong.
        vRes := self nextLong.
        pixelType := self nextWord.
        pixelSize := self nextWord.
        cmpCount := self nextWord.
        cmpSize := self nextWord.
        planeBytes := self nextLong.
        pmTable := self nextLong.
        pmReserved := self nextLong.
        srcRect := self readRect.
        dstRect := self readRect.
        mode := self nextWord.
        isMaskRgn = true ifTrue: [maskRgn := self readRegion].
        anImage := self readDirectPixData.
        " self debug: [anImage displayOn: ScheduledControllers activeController view graphicsContext]. "
"/ OLD:
"/        anArray := Array
"/                                with: anImage
"/                                with: srcRect
"/                                with: dstRect
"/                                with: mode.
"/        isMaskRgn = true ifTrue: [
"/            anArray := anArray , (Array with: maskRgn)
"/        ].

"/ NEW:
        anArray := PICTFrame new
                    image:anImage 
                    sourceRectangle:srcRect 
                    destinationRectangle:dstRect 
                    mode:mode.
        isMaskRgn = true ifTrue: [
            anArray maskRegion:maskRgn
        ].
        ^anArray
!

readDirectPixRowData
        | rawData byteCount |
        (packType = 1 or: [rowBytes < 8])
                ifTrue: [rawData := self next: rowBytes]
                ifFalse: [packType = 2
                                ifTrue: [rawData := self next: (rowBytes * (3 / 4)) asInteger]
                                ifFalse: [packType > 2
                                                ifTrue: 
                                                        [rowBytes > 250
                                                                ifTrue: [byteCount := self nextWord]
                                                                ifFalse: [byteCount := self next].
                                                        rawData := self unPackBits: (self next: byteCount)]]].
        ^rawData
!

readHeader
        | position byte |
        picSize := self nextWord.
        picFrame := self readRect.
        position := self position.
        byte := self next.
        byte = 16r11
                ifTrue: [picVersion := self next]
                ifFalse: 
                        [byte := self next.
                        byte = 16r11
                                ifTrue: 
                                        [picVersion := self next.
                                        self next]
                                ifFalse: [^self errorCanNotRead]].
        self position: position
!

readPixData
        | pixData |
        pixData := ByteArray new: rowBytes * bounds height.
        self progress: 0.
        1 to: bounds height
                do: 
                        [:column | 
                        | start stop replacement |
                        start := column - 1 * rowBytes + 1.
                        stop := column * rowBytes.
                        replacement := self readPixRowData.
                        pixData
                                replaceBytesFrom: start
                                to: stop
                                with: replacement
                                startingAt: 1.
                        self progress: column / bounds height].
        ^pixData
!

readPixMap: isMaskRgn 
        | pixData aPalette anImage pad maskRgn anArray |
        rowBytes := self nextWord bitAnd: 16r3FFF.
        bounds := self readRect.
        pmVersion := self nextWord.
        packType := self nextWord.
        packSize := self nextLong.
        hRes := self nextLong.
        vRes := self nextLong.
        pixelType := self nextWord.
        pixelSize := self nextWord.
        cmpCount := self nextWord.
        cmpSize := self nextWord.
        planeBytes := self nextLong.
        pmTable := self nextLong.
        pmReserved := self nextLong.
        self readColorTable.
        srcRect := self readRect.
        dstRect := self readRect.
        mode := self nextWord.
        isMaskRgn = true ifTrue: [maskRgn := self readRegion].
        pixData := self readPixData.
        aPalette := MappedPalette withColors: (ctTable collect: [:rgb | self colorValueFrom: rgb]).
        pad := rowBytes * 8 - (bounds width * pixelSize).
        pad >= 8
                ifTrue: [pad >= 16
                                ifTrue: [pad := 32]
                                ifFalse: [pad := 16]]
                ifFalse: [pad := 8].
        anImage := Image
                                extent: bounds width @ bounds height
                                depth: pixelSize
                                palette: aPalette
                                bits: pixData
                                pad: pad.
        " self debug: [anImage displayOn: ScheduledControllers activeController view graphicsContext]. "
"/ OLD:
"/        anArray := Array
"/                                with: anImage
"/                                with: srcRect
"/                                with: dstRect
"/                                with: mode.
"/        isMaskRgn = true ifTrue: [anArray := anArray , (Array with: maskRgn)].
"/ NEW:
        anArray := PICTFrame new
                    image:anImage 
                    sourceRectangle:srcRect 
                    destinationRectangle:dstRect 
                    mode:mode.
        isMaskRgn = true ifTrue: [
            anArray maskRegion:maskRgn
        ].
        ^anArray
!

readPixRowData
        packType = 0 ifTrue: [^self readBitRowData].
        packType = 1 ifTrue: [^self readBitRowData].
        ^self errorCanNotRead
!

readPoint
        | x y point |
        x := self nextWord.
        y := self nextWord.
        point := x @ y.
        ^point
!

readPolygon
        | length bytes |
        length := self nextWord.
        bytes := self next: length - 2.
        " self
                debug: 
                        [Transcript space; show: length printString.
                        Transcript space; show: bytes printString]. "
        ^Array with: length with: bytes
!

readRect
        | top left bottom right rect |
        top := self nextWord.
        left := self nextWord.
        bottom := self nextWord.
        right := self nextWord.
        rect := left @ top corner: right @ bottom.
        ^rect
!

readRegion
        | length bytes |
        length := self nextWord.
        bytes := self next: length - 2.
        " self debug: 
                [Transcript space; show: length printString.
                Transcript space; show: bytes printString]. "
        ^Array with: length with: bytes
! !

!PICTReader methodsFor:'encoding'!

bitData: bitData 
        | imageRowBytes packStream |
        imageRowBytes := bounds width * pixelSize + 31 // 32 * 4.
        packStream := WriteStream on: (ByteArray new: bitData size).
        self progress: 0.
        1 to: bounds height
                do: 
                        [:h | 
                        | rowBits packedBits |
                        rowBits := bitData copyFrom: h - 1 * imageRowBytes + 1 to: h - 1 * imageRowBytes + rowBytes.
                        rowBytes < 8
                                ifTrue: [packStream nextPutAll: rowBits]
                                ifFalse: 
                                        [packedBits := self packBits: rowBits.
                                        rowBytes > 250
                                                ifTrue: 
                                                        [packStream nextPut: ((packedBits size bitShift: -8)
                                                                        bitAnd: 255).
                                                        packStream nextPut: (packedBits size bitAnd: 255)]
                                                ifFalse: [packStream nextPut: packedBits size].
                                        packStream nextPutAll: packedBits].
                        self progress: h / bounds height].
        ^packStream contents
!

directPixData4: anImage 
        | packStream palette r g b index color scalingValue stream |
        packStream := WriteStream on: (ByteArray new: anImage bits size).
        palette := anImage palette.
        self progress: 0.
        0 to: bounds height - 1
                do: 
                        [:y | 
                        r := WriteStream on: ByteArray new.
                        g := WriteStream on: ByteArray new.
                        b := WriteStream on: ByteArray new.
                        0 to: bounds width - 1
                                do: 
                                        [:x | 
                                        index := anImage atX: x y: y.
                                        (palette includesKey: index)
                                                ifTrue: [color := palette at: index]
                                                ifFalse: [color := palette at: (index bitAnd: palette maxIndex)].
                                        scalingValue := ColorValue scalingValue.
                                        r nextPut: (self
                                                        convertValue: color scaledRed
                                                        from: scalingValue
                                                        to: 255).
                                        g nextPut: (self
                                                        convertValue: color scaledGreen
                                                        from: scalingValue
                                                        to: 255).
                                        b nextPut: (self
                                                        convertValue: color scaledBlue
                                                        from: scalingValue
                                                        to: 255)].
                        stream := WriteStream on: ByteArray new.
                        stream nextPutAll: r contents.
                        stream nextPutAll: g contents.
                        stream nextPutAll: b contents.
                        packStream nextPutAll: (self directPixRowData: stream contents).
                        self progress: y / (bounds height - 1)].
        ^packStream contents
!

directPixRowData: row 
        | aStream rawData byteCount |
        aStream := WriteStream on: (ByteArray new: row size).
        rawData := self packBits: row.
        byteCount := rawData size.
        rowBytes > 250
                ifTrue: 
                        [aStream nextPut: ((byteCount bitShift: -8)
                                        bitAnd: 255).
                        aStream nextPut: (byteCount bitAnd: 255)]
                ifFalse: [aStream nextPut: byteCount].
        aStream nextPutAll: rawData.
        ^aStream contents
!

nextPutImage24: image 
        | anImage endOpcode |
        Cursor wait showWhile: [anImage := image "convertToPalette: (FixedPalette
                                                redShift: 16
                                                redMask: 255
                                                greenShift: 8
                                                greenMask: 255
                                                blueShift: 0
                                                blueMask: 255)
                                        renderedBy: ErrorDiffusion new"].
        baseAddr := 16r000000FF.
        rowBytes := anImage width * 32 + 7 // 8.
        bounds := anImage bounds.
        pmVersion := 0.
        packType := 4.
        packSize := 0.
        hRes := 16r00480000.
        vRes := 16r00480000.
        pixelType := 16.
        pixelSize := 32.
        cmpCount := 3.
        cmpSize := 8.
        planeBytes := 0.
        pmTable := 0.
        pmReserved := 0.
        srcRect := anImage bounds.
        dstRect := anImage bounds.
        mode := 64.
        endOpcode := 16r00FF.
        self writeImage24: anImage.
        self writeOpcode: endOpcode.
        ^anImage
!

sortPalette: image 
        | max array color |
        max := 1 bitShift: pixelSize.
        array := Array new: image palette maxIndex + 1.
        1 to: array size
                do: 
                        [:i | 
                        color := image palette at: i - 1 ifAbsent: [ColorValue white].
                        array at: i put: (self rgbIntegerFrom: color)].
        array size > max
                ifTrue: [array := array copyFrom: 1 to: max]
                ifFalse: [array size < max ifTrue: [array := array , (Array new: max - array size withAll: 0)]].
        array := array asSortedCollection reverse collect: [:rgb | self colorValueFrom: rgb].
        ^image convertToPalette: (MappedPalette withColors: array)
!

writeBits24: bits 
        | currentOpecode |
        currentOpecode := 16r009A.
        self writeOpcode: currentOpecode.
        self nextLongPut: baseAddr.
        self nextWordPut: rowBytes + (1 bitShift: 15).
        self writeRect: bounds.
        self nextWordPut: pmVersion.
        self nextWordPut: packType.
        self nextLongPut: packSize.
        self nextLongPut: hRes.
        self nextLongPut: vRes.
        self nextWordPut: pixelType.
        self nextWordPut: pixelSize.
        self nextWordPut: cmpCount.
        self nextWordPut: cmpSize.
        self nextLongPut: planeBytes.
        self nextLongPut: pmTable.
        self nextLongPut: pmReserved.
        self writeRect: srcRect.
        self writeRect: dstRect.
        self nextWordPut: mode.
        self nextPutAll: bits
!

writeBits: bits palette: palette 
        rowBytes < 8
                ifTrue: [currentOpcode := 16r90]
                ifFalse: [currentOpcode := 16r0098].
        picVersion = 1
                ifTrue: 
                        [self writeOpcode: currentOpcode.
                        self nextWordPut: rowBytes.
                        self writeRect: bounds.
                        self writeRect: srcRect.
                        self writeRect: dstRect.
                        self nextWordPut: mode.
                        self nextPutAll: bits]
                ifFalse: 
                        [self writeOpcode: currentOpcode.
                        self nextWordPut: rowBytes + (1 bitShift: 15).
                        self writeRect: bounds.
                        self nextWordPut: pmVersion.
                        self nextWordPut: packType.
                        self nextLongPut: packSize.
                        self nextLongPut: hRes.
                        self nextLongPut: vRes.
                        self nextWordPut: pixelType.
                        self nextWordPut: pixelSize.
                        self nextWordPut: cmpCount.
                        self nextWordPut: cmpSize.
                        self nextLongPut: planeBytes.
                        self nextLongPut: pmTable.
                        self nextLongPut: pmReserved.
                        self nextLongPut: ctSeed.
                        self nextWordPut: ctFlags.
                        self nextWordPut: ctSize.
                        ctTable := Array new: palette maxIndex + 1.
                        1 to: ctTable size
                                do: 
                                        [:i | 
                                        | color value rgb |
                                        color := palette at: i - 1 ifAbsent: [ColorValue white].
                                        value := 0.
                                        rgb := self rgbIntegerFrom: color.
                                        ctTable at: i put: rgb.
                                        self nextWordPut: value.
                                        self nextWordPut: ((rgb bitShift: -32)
                                                        bitAnd: 65535).
                                        self nextWordPut: ((rgb bitShift: -16)
                                                        bitAnd: 65535).
                                        self nextWordPut: (rgb bitAnd: 65535)].
                        self writeRect: srcRect.
                        self writeRect: dstRect.
                        self nextWordPut: mode.
                        self nextPutAll: bits]
!

writeClip: aRectangle 
        picVersion = 1
                ifTrue: [self writeOpcode: 16r01]
                ifFalse: [self writeOpcode: 16r0001].
        self nextWordPut: 10.
        self writeRect: aRectangle
!

writeHeader24: bits 
        | pictCodeSize |
        pictCodeSize := 2.
        picSize := 40.
        picSize := picSize + pictCodeSize.
        picSize := picSize + pictCodeSize + 10.
        picSize := picSize + pictCodeSize + 68 + bits size.
        bits size odd ifTrue: [picSize := picSize + 1].
        picSize := picSize + pictCodeSize.
        self nextWordPut: picSize \\ 65535.
        self writeRect: picFrame.
        self nextWordPut: 17.
        self nextWordPut: 767.
        self nextWordPut: 3072.
        1 to: 2 do: [:i | self nextWordPut: 65535].
        1 to: 4 do: [:i | self nextWordPut: 0].
        self nextWordPut: picFrame width.
        1 to: 1 do: [:i | self nextWordPut: 0].
        self nextWordPut: picFrame height.
        1 to: 3 do: [:i | self nextWordPut: 0]
!

writeHeader: bits palette: palette
        | pictCodeSize |
        picVersion = 1
                ifTrue: 
                        [pictCodeSize := 1.
                        picSize := 12.
                        picSize := picSize + pictCodeSize + 10.
                        picSize := picSize + pictCodeSize + 10 + 8 + 8 + 2 + bits size.
                        picSize := picSize + pictCodeSize]
                ifFalse: 
                        [pictCodeSize := 2.
                        picSize := 40.
                        picSize := picSize + pictCodeSize.
                        picSize := picSize + pictCodeSize + 10.
                        picSize := picSize + pictCodeSize + 46 + 8 + (palette maxIndex + 1 * 8) + 8 + 8 + 2 + bits size.
                        bits size odd ifTrue: [picSize := picSize + 1].
                        picSize := picSize + pictCodeSize].
        self nextWordPut: picSize \\ 65535.
        self writeRect: picFrame.
        picVersion = 1
                ifTrue: 
                        [self nextPut: 17.
                        self nextPut: 1]
                ifFalse: 
                        [self nextWordPut: 17.
                        self nextWordPut: 767.
                        self nextWordPut: 3072.
                        1 to: 2 do: [:i | self nextWordPut: 65535].
                        1 to: 4 do: [:i | self nextWordPut: 0].
                        self nextWordPut: picFrame width.
                        1 to: 1 do: [:i | self nextWordPut: 0].
                        self nextWordPut: picFrame height.
                        1 to: 3 do: [:i | self nextWordPut: 0]]
!

writeImage24: anImage 
        | bits |
        bits := self directPixData4: anImage.
        self writeHeader24: ByteArray new.
        self writeClip: bounds.
        self writeBits24: bits.
        ^anImage
!

writeImage: anImage 
        | image bits |
        image := self sortPalette: anImage.
        bits := self bitData: image bits.
        self writeHeader: bits palette: image palette.
        self writeClip: bounds.
        self writeBits: bits palette: image palette.
        ^anImage
!

writeOpcode: opcode 
        picVersion = 1
                ifTrue: [self nextPut: opcode]
                ifFalse: 
                        [self position odd ifTrue: [self nextPut: 0].
                        self nextWordPut: opcode]
!

writeRect: aRectangle 
        self nextWordPut: aRectangle top.
        self nextWordPut: aRectangle left.
        self nextWordPut: aRectangle bottom.
        self nextWordPut: aRectangle right
! !

!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] "
!

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]
!

nextOpcode
        | association |
        " self debug: [Transcript cr.
                     Transcript show: (self hexString4: self position).
                     Transcript show: ':']. "
        picVersion = 1
                ifTrue: [currentOpcode := self next]
                ifFalse: 
                        [self position odd ifTrue: [self next].
                        currentOpcode := self nextWord].
        association := self class opcodeAt: currentOpcode.
        association isNil ifTrue: [^self errorUnexpectedOpcode].
        self interpretOpcode: association.
        ^association
!

variableOpcode: opcodeName additionalData: additionalData 
        | aSymbol |

        " 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)
                                , (opcodeName copyFrom: 2 to: opcodeName size)) asSymbol.
        (self respondsTo: aSymbol)
                ifTrue: [^self perform: aSymbol].
        ^self errorUnexpectedOpcode
! !

!PICTReader methodsFor:'printing'!

hexString2: aNumber 
        | aString aStream |
        aString := aNumber printStringRadix: 16.
        aStream := WriteStream on: (String new: 12).
        aStream nextPutAll: '16r'.
        2 - aString size timesRepeat: [aStream nextPutAll: '0'].
        aStream nextPutAll: aString.
        ^aStream contents
!

hexString4: aNumber 
        | aString aStream |
        aString := aNumber printStringRadix: 16.
        aStream := WriteStream on: (String new: 12).
        aStream nextPutAll: '16r'.
        4 - aString size timesRepeat: [aStream nextPutAll: '0'].
        aStream nextPutAll: aString.
        ^aStream contents
!

hexString8: aNumber 
        | aString aStream |
        aString := aNumber printStringRadix: 16.
        aStream := WriteStream on: (String new: 12).
        aStream nextPutAll: '16r'.
        8 - aString size timesRepeat: [aStream nextPutAll: '0'].
        aStream nextPutAll: aString.
        ^aStream contents
! !

!PICTReader methodsFor:'private'!

colorValueFrom: rgbInteger 
        | scalingValue |

        ^ Color 
            redShort:((rgbInteger bitShift: -32) bitAnd: 65535)
            greenShort:((rgbInteger bitShift: -16) bitAnd: 65535) 
            blueShort:(rgbInteger bitAnd: 65535)

"/        scalingValue := ColorValue scalingValue.
"/        ^ColorValue
"/                scaledRed: (self
"/                                convertValue: ((rgbInteger bitShift: -32)
"/                                                bitAnd: 65535)
"/                                from: 65535
"/                                to: scalingValue)
"/                scaledGreen: (self
"/                                convertValue: ((rgbInteger bitShift: -16)
"/                                                bitAnd: 65535)
"/                                from: 65535
"/                                to: scalingValue)
"/                scaledBlue: (self
"/                                convertValue: (rgbInteger bitAnd: 65535)
"/                                from: 65535
"/                                to: scalingValue)
!

errorSorryNotSupported
        self error: 'sorry, not supported'.
        ^nil
!

errorUnexpectedOpcode
        | string |
        picVersion = 1
                ifTrue: [string := self hexString2: currentOpcode]
                ifFalse: [string := self hexString4: currentOpcode].
        string := (self hexString8: self position)
                                , ': ' , string.
        self error: 'unexpected opcode: ' , string.
        ^nil
!

errorUnexpectedPakingType
        self error: 'unexpected packing type: ' , packType printString.
        ^nil
!

mergeImages
        | aRectangle aDepth aPalette anImage aPattern indexValue |
        aRectangle := nil.
        aDepth := nil.
        aPalette := nil.
        imageSequence
                do: 
                        [:array | 
                        aRectangle isNil
                                ifTrue: [aRectangle := array at: 3]
                                ifFalse: [aRectangle := aRectangle merge: (array at: 3)].
                        aDepth isNil
                                ifTrue: 
                                        [aDepth := (array at: 1) depth.
                                        aPalette := (array at: 1) palette]
                                ifFalse: [aDepth < (array at: 1) depth
                                                ifTrue: 
                                                        [aDepth := (array at: 1) depth.
                                                        aPalette := (array at: 1) palette]]].
        anImage := Image
                                extent: aRectangle extent
                                depth: aDepth
                                palette: aPalette.
        aPattern := Image
                                extent: 16 @ 16
                                depth: anImage depth
                                palette: anImage palette.
        indexValue := aPattern palette indexOfPaintNearest: ColorValue white.
        0 to: aPattern width - 1 do: [:x | 0 to: aPattern height - 1 do: [:y | aPattern atPoint: x @ y put: indexValue]].
        anImage
                tile: aRectangle
                from: Point zero
                in: aPattern
                rule: RasterOp over.
        imageSequence
                do: 
                        [:array | 
                        | srcImage srcR dstR |
                        srcImage := array at: 1.
                        srcR := array at: 2.
                        dstR := array at: 3.
                        srcImage palette = aPalette ifFalse: [srcImage := srcImage convertToPalette: aPalette renderedBy: ErrorDiffusion new].
                        dstR := dstR translatedBy: Point zero - aRectangle origin.
                        anImage
                                copy: dstR
                                from: srcR origin
                                in: srcImage
                                rule: RasterOp over].
        ^anImage
!

packBits: bits 
        | packStream prev writeBlock bitSize bitPos start code replicateSize literalSize |
        packStream := WriteStream on: (ByteArray new: bits size).
        prev := nil.
        writeBlock := [:asc | asc key < 0
                                ifTrue: 
                                        ["replicate"
                                        packStream nextPut: asc key negated.
                                        packStream nextPut: asc value]
                                ifFalse: 
                                        ["literal"
                                        | litStart litStop |
                                        litStart := asc value first.
                                        litStop := asc value last.
                                        asc key = (litStop - litStart) ifFalse: [self error: 'can''t happen'].
                                        [litStop - litStart + 1 > 128]
                                                whileTrue: 
                                                        [packStream nextPut: 127.
                                                        litStart to: litStart + 127 do: [:litIndex | packStream nextPut: (bits at: litIndex)].
                                                        litStart := litStart + 128].
                                        litStart <= litStop
                                                ifTrue: 
                                                        [packStream nextPut: litStop - litStart + 1 - 1.
                                                        litStart to: litStop do: [:litIndex | packStream nextPut: (bits at: litIndex)]]]].
        bitSize := bits size.
        bitPos := 1.
        [bitPos <= bitSize]
                whileTrue: 
                        [start := bitPos.
                        code := bits at: start.
                        [(bitPos := bitPos + 1) <= bitSize and: [(bits at: bitPos)
                                        = code]]
                                whileTrue: [].
                        replicateSize := bitPos - start.
                        replicateSize > 128
                                ifTrue: 
                                        [prev == nil
                                                ifFalse: 
                                                        [writeBlock value: prev.
                                                        prev := nil].
                                        [replicateSize > 128]
                                                whileTrue: 
                                                        [writeBlock value: -129 -> code.
                                                        start := start + 128.
                                                        replicateSize := replicateSize - 128]].
                        replicateSize = 2
                                ifTrue: 
                                        ["treat as literal"
                                        literalSize := 2.
                                        prev ~~ nil ifTrue: [prev key >= 0
                                                        ifTrue: 
                                                                ["prev is literal"
                                                                literalSize := literalSize + prev value size.
                                                                start := prev value first]
                                                        ifFalse: 
                                                                [writeBlock value: prev.
                                                                prev := nil]].
                                        prev := literalSize - 1 -> (start to: start + literalSize - 1)]
                                ifFalse: [replicateSize > 2
                                                ifTrue: 
                                                        [prev == nil
                                                                ifFalse: 
                                                                        [writeBlock value: prev.
                                                                        prev := nil].
                                                        prev := (256 - (replicateSize - 1)) negated -> code]
                                                ifFalse: ["replicateSize < 2"
                                                        bitPos := bitPos - 1]].
                        (start := bitPos) <= bitSize
                                ifTrue: 
                                        [code := bits at: start.
                                        [(bitPos := bitPos + 1) <= bitSize and: [(bits at: bitPos)
                                                        ~= code]]
                                                whileTrue: [code := bits at: bitPos].
                                        bitPos <= bitSize ifTrue: [bitPos := bitPos - 1].
                                        literalSize := bitPos - start.
                                        literalSize > 0
                                                ifTrue: 
                                                        [prev ~~ nil ifTrue: [prev key >= 0
                                                                        ifTrue: 
                                                                                ["prev is literal"
                                                                                literalSize := literalSize + prev value size.
                                                                                start := prev value first]
                                                                        ifFalse: 
                                                                                [writeBlock value: prev.
                                                                                prev := nil]].
                                                        prev := literalSize - 1 -> (start to: start + literalSize - 1)]]].
        prev == nil
                ifFalse: 
                        [writeBlock value: prev.
                        prev := nil].
        ^packStream contents
!

progress:fraction
    self reportProgress:fraction
!

rgbIntegerFrom: aColorValue 
        | scalingValue |
        scalingValue := ColorValue scalingValue.
        ^((self
                convertValue: aColorValue scaledRed
                from: scalingValue
                to: 65535)
                bitShift: 32)
                + ((self
                                convertValue: aColorValue scaledGreen
                                from: scalingValue
                                to: 65535)
                                bitShift: 16) + (self
                        convertValue: aColorValue scaledBlue
                        from: scalingValue
                        to: 65535)
!

unPackBits: bits 
        | unpackStream bitSize bitPos code |
        unpackStream := WriteStream on: (ByteArray new: bits size).
        bitSize := bits size.
        bitPos := 0.
        [(bitPos := bitPos + 1) <= bitSize]
                whileTrue: 
                        [code := bits at: bitPos.
                        code < 128
                                ifTrue: [1 to: code + 1 do: [:i | unpackStream nextPut: (bits at: (bitPos := bitPos + 1))]]
                                ifFalse: [code > 128
                                                ifTrue: 
                                                        [bitPos := bitPos + 1.
                                                        1 to: 256 - code + 1 do: [:i | unpackStream nextPut: (bits at: bitPos)]]]].
        ^unpackStream contents
! !

!PICTReader methodsFor:'reading'!

fromStream: aStream 
    "read an image in my format from aStream.
     Dtermine if its a raster or icon file."

    |endOpcode|

"/    ^ self fileFormatError:'Sorry - PICT image implementation is incomplete'.

    inStream := aStream.
    aStream binary.

    inStream skip:512.      "apples file header"

    currentOpcode := nil.
    imageSequence := OrderedCollection new.
    self readHeader.
    self reportDimension.
    endOpcode := 16r00FF.
    [currentOpcode = endOpcode] whileFalse: [self nextOpcode].

    imageSequence isEmpty ifTrue: [^nil].
    imageSequence size = 1 ifTrue: [
        "/ OLD:
        "/ ^ imageSequence first first
        "/ NEW:
        ^ imageSequence first image
    ].
    ^ self mergeImages

    "
     PICTReader fromFile:'/unsaved2/stefan/nil/home/stefan/dos/winword/shared/ms.pct'
    "
! !

!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)
"/                                and: [imageStream stream isKindOf: ExternalStream]])
"/                ifTrue: [self nextPutAll: (ByteArray new: 512)].
"/        picSize := 0.
"/        picFrame := 0 @ 0 extent: anImage extent.
"/        anImage bitsPerPixel = 1
"/                ifTrue: [picVersion := 1]
"/                ifFalse: [picVersion := 2].
"/        anImage bitsPerPixel > 8 ifTrue: [^self nextPutImage24: anImage].
"/        rowBytes := anImage width * anImage bitsPerPixel + 7 // 8.
"/        bounds := anImage bounds.
"/        pmVersion := 0.
"/        packType := 0.
"/        packSize := 0.
"/        hRes := '16r00480000' asNumber.
"/        vRes := '16r00480000' asNumber.
"/        pixelType := 0.
"/        pixelSize := anImage bitsPerPixel.
"/        cmpCount := 1.
"/        cmpSize := anImage bitsPerPixel.
"/        planeBytes := 0.
"/        pmTable := 0.
"/        pmReserved := 0.
"/        ctSeed := 0.
"/        ctFlags := '16r8000' asNumber.
"/        ctSize := anImage palette maxIndex.
"/        ctTable := nil.
"/        srcRect := anImage bounds.
"/        dstRect := anImage bounds.
"/        mode := 0.
"/        endOpcode := '16r00FF' asNumber.
"/        self writeImage: anImage.
"/        self writeOpcode: endOpcode.
"/        ^anImage
! !

!PICTReader::PICTFrame methodsFor:'accessing'!

destinationRectangle
    ^ destinationRectangle
!

image
    ^ image
!

image:imageArg sourceRectangle:sourceRectangleArg destinationRectangle:destinationRectangleArg mode:modeArg 
    "set instance variables (automatically generated)"

    image := imageArg.
    sourceRectangle := sourceRectangleArg.
    destinationRectangle := destinationRectangleArg.
    mode := modeArg.
!

maskRegion
    ^ maskRegion
!

maskRegion:something
    maskRegion := something.
!

mode
    ^ mode
!

sourceRectangle
    ^ sourceRectangle
! !

!PICTReader class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview2/PICTReader.st,v 1.8 2003-11-19 19:19:27 cg Exp $'
! !

PICTReader initialize!