"

 COPYRIGHT (c) 1994 by Claus Gittinger

	      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

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libview2' }"

ImageReader subclass:#XPMReader

	classVariableNames:''

	poolDictionaries:''

	category:'Graphics-Images-Support'

!

!XPMReader class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1994 by Claus Gittinger

	      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

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    this class provides methods for loading x-pixmap-file (xpm) images.

    These images are used (in X) for palette images (see ctwm or hp-vue for a lot

    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.

        Can only handle single-character index.

        Only understands single-word color names (i.e. names with spaces 

        are not supported)

        Image writing is only supported for images with less than about 50

        colors (single byte encoding). If present, the mask must be a

        single bit mask (i.e. no alpha channel).

        Due to the algorithm, writing may be slow for big images

    Suggestions: adapt & use the XPM library here.

    [See also:]

        Image Form Icon

        BlitImageReader FaceReader GIFReader JPEGReader PBMReader PCXReader 

        ST80FormReader SunRasterReader TargaReader TIFFReader WindowsIconReader 

        XBMReader XWDReader 

"

! !

!XPMReader class methodsFor:'initialization'!

initialize

    "tell Image-class, that a new fileReader is present

     for the '.xpm' and '.pm' extensions."

    MIMETypes defineImageType:'image/x-xpixmap' suffix:'xpm' reader:self.

    MIMETypes defineImageType:nil               suffix:'pm'  reader:self.

    "Modified: 1.2.1997 / 15:10:29 / cg"

! !

!XPMReader class methodsFor:'testing'!

canRepresent:anImage

    "return true, if anImage can be represented in my file format.

     Currently only images with less than 80 colors are supported."

    anImage depth <= 6 ifTrue:[^ true].

    anImage photometric == #palette ifTrue:[

        anImage colorMap size < 80 ifTrue:[^ true].

    ].

    anImage usedColors size < 80 ifTrue:[^ true].

    Transcript showCR:'XPMReader: too many colors in image.'.

    ^ false

    "Modified: 27.2.1997 / 12:40:22 / cg"

!

isValidImageFile:aFileName

    "return true, if aFileName contains an x-bitmap-file image"

    |line inStream |

    inStream := self streamReadingFile:aFileName.

    inStream isNil ifTrue:[^ false].

    Stream readErrorSignal handle:[:ex |

        line := nil

    ] do:[

        Stream lineTooLongErrorSignal handle:[:ex |

            line := nil.

            Transcript showCR:'long line'.

            ex return.

        ] do:[

            line := inStream nextLine.

        ]

    ].

    inStream close.

    line isNil ifTrue:[^ false].

    (line startsWith:'/* XPM') ifFalse:[^ false].

    ^ true

    "

     XPMReader isValidImageFile:'fooBar'    

     XPMReader isValidImageFile:'bitmaps/gifImages/garfield.gif' 

    "

    "Modified: 24.4.1997 / 20:29:40 / cg"

! !

!XPMReader methodsFor:'reading from file'!

colorNameFrom:aStream

    "read either a color-name or value specified in X-notation

     (#rrggbb where rr, gg and bb are 2-digit hex numbers)"

    |s|

    aStream peek == $# ifTrue:[

	aStream next.

	s := '#'.

    ] ifFalse:[

	s := ''.

    ].

    [aStream peek isLetterOrDigit] whileTrue:[

	s := s copyWith:aStream next

    ].

    ^ s

!

    redMap := ByteArray new:colorMapSize.

    greenMap := ByteArray new:colorMapSize.

    blueMap := ByteArray new:colorMapSize.

    colorMap := Colormap redVector:redMap greenVector:greenMap blueVector:blueMap.

    1 to:colorMapSize do:[:colorIndex |

        |index line color t word|

        [line notNil and:[line startsWith:'/*']] whileTrue:[

            [line notNil and:[(line endsWith:'*/') not]] whileTrue:[

            ].

        ].

        line notNil ifTrue:[

            line := line withoutSeparators

        ].

        (line notNil and:[line startsWith:'"']) ifFalse:[

            ^ self fileFormatError:'format error (expected color spec)'.

        ].

        s := ReadStream on:line.

        s next. "skip quote"

        charsPerPixel ~~ 1 ifTrue:[

            key := s next:charsPerPixel.

        ] ifFalse:[

            index := s next asciiValue.

        ].

        lineDone := false.

        state := nil.

        [lineDone] whileFalse:[

            s skipSeparators.

            s peek == $# ifTrue:[

                word := self colorNameFrom:s

            ] ifFalse:[

                word := s nextAlphaNumericWord.

            ].

            word isNil ifTrue:[

                lineDone := true

            ] ifFalse:[

                word = 's' ifTrue:[

                    "/ symbolic name ...

                    state := $s. symbolicName := ''.

                ] ifFalse:[

                    word = 'm' ifTrue:[

                        "/ monochrome data

                        state := $m. monoName := ''.

                    ] ifFalse:[

                        word = 'g' ifTrue:[

                            "/ grey data

                            state := $g. greyName := ''.

                        ] ifFalse:[

                            word = 'g4' ifTrue:[

                                "/ grey data

                                state := $G. grey4Name := ''.

                            ] ifFalse:[

                                word = 'c' ifTrue:[

                                    "/ color data

                                    state := $c. colorName := ''.

                                ] ifFalse:[

                                    "/ append to name

                                    state isNil ifTrue:[

                                        ^ self fileFormatError:('format error got: ' 

                                                                , word printString 

                                                                , ' (expected ''c'',''m'',''g'' or ''s'')').

                                    ].

                                    state == $m ifTrue:[

                                        monoName := monoName , ' ' , word.

                                    ].

                                    state == $g ifTrue:[

                                        greyName := greyName , ' ' , word.

                                    ].

                                    state == $G ifTrue:[

                                        grey4Name := grey4Name , ' ' , word.

                                    ].

                                    state == $c ifTrue:[

                                        colorName := colorName , ' ' , word.

                                    ].

                                    state == $s ifTrue:[

                                        symbolicName := symbolicName , ' ' , word.

                                    ].

                                    (word startsWith:'#') ifTrue:[

                                        state := nil.

                                    ]

                                ]

                            ]

                        ]

                    ]

                ]

            ].

        ].

        colorName notNil ifTrue:[

            colorName := colorName withoutSeparators

        ].

        monoName notNil ifTrue:[

            monoName := monoName withoutSeparators

        ].

        greyName notNil ifTrue:[

            greyName := greyName withoutSeparators

        ].

        grey4Name notNil ifTrue:[

            grey4Name := grey4Name withoutSeparators

        ].

        symbolicName notNil ifTrue:[

            symbolicName := symbolicName withoutSeparators

        ].

        "/

        "/ for now - ignore everything, except

        "/ colorName (if there is one)

        "/

        colorName isNil ifTrue:[

            colorName := greyName.

            colorName isNil ifTrue:[

                colorName := monoName.

            ]

        ].

        (colorName sameAs: 'none') ifTrue:[

            color := Color noColor. "/ white

            redMap at:colorIndex put:0.

            greenMap at:colorIndex put:0.

            blueMap at:colorIndex put:0.

            maskPixelValue := colorIndex-1.

        ] ifFalse:[

            color := Color name:colorName ifIllegal:Color black.

            redMap at:colorIndex put:(color red asFloat * 255.0 // 100).

            greenMap at:colorIndex put:(color green asFloat * 255.0 // 100).

            blueMap at:colorIndex put:(color blue asFloat * 255.0 // 100).

        ].

    ].

    "actually, could make it an image with less depth most of the time ..."

"

    bitsPerPixel := ((colorMapSize - 1) log:2) truncated + 1.

"

    colorMapSize > 256 ifTrue:[

        bitsPerPixel := 24.

        data := ByteArray new:(width * height * 3).

    ] ifFalse:[

        bitsPerPixel := 8.

        data := ByteArray new:(width * height).

    ].

    dstIndex := 1.

    1 to:height do:[:row |

        [line notNil and:[line startsWith:'/*']] whileTrue:[

        ].

        line notNil ifTrue:[

            line := line withoutSeparators

        ].

        (line notNil and:[line startsWith:'"']) ifFalse:[

            ^ self fileFormatError:'format error (expected pixels)'.

        ].

        charsPerPixel == 1 ifTrue:[

            srcIndex := 2. "skip dquote"

            1 to:width do:[:col |

                key := line at:srcIndex.

                key ~~ lastKey ifTrue:[

                    lastKey := key

                ].

                data at:dstIndex put:lastXLation.

                srcIndex := srcIndex + 1.

                dstIndex := dstIndex + 1

            ]

        ] ifFalse:[

            charsPerPixel == 2 ifTrue:[

                "/ sorry, but this ugly code does a lot for speed,

                "/ when reading big Xpm files (factor=5 for banner8.xpm)  ...

                srcIndex := 2."skip dquote"

                lastChar1 := lastChar2 := nil.

                key := String new:2.

                1 to:width do:[:col |

                    c1 := line at:srcIndex.

                    c2 := line at:srcIndex+1.

                    (c1 ~~ lastChar1 or:[c2 ~~ lastChar2]) ifTrue:[

                        key at:1 put:c1.

                        key at:2 put:c2.

                        lastChar1 := c1.

                        lastChar2 := c2.

                    ].

                    bitsPerPixel == 24 ifTrue:[

                        data at:dstIndex   put:(colorMap at:lastXLation+1) redByte.

                        data at:dstIndex+1 put:(colorMap at:lastXLation+1) greenByte.

                        data at:dstIndex+2 put:(colorMap at:lastXLation+1) blueByte.

                        dstIndex := dstIndex + 3.

                    ] ifFalse:[

                        data at:dstIndex put:lastXLation.

                        dstIndex := dstIndex + 1.

                    ].

                    srcIndex := srcIndex + 2.

                ]

            ] ifFalse:[

                s := line readStream.

                s next. "/ skip dquote

                1 to:width do:[:col |

                    key := s next:charsPerPixel.

                    key ~= lastKey ifTrue:[

                        lastKey := key

                    ].

                    data at:dstIndex put:lastXLation.

                    dstIndex := dstIndex + 1

                ]

            ]

        ]

    ].

    bitsPerPixel == 24 ifTrue:[

        photometric := #rgb.

        samplesPerPixel := 3.

        bitsPerSample := #(8 8 8).

    ] ifFalse:[

        photometric := #palette.

        samplesPerPixel := 1.

        bitsPerSample := Array with:bitsPerPixel.

    ].

    maskPixelValue notNil ifTrue:[

        self buildMaskFromColor:maskPixelValue

    ].

    "

    "

    "Created: / 24.9.1995 / 06:20:06 / claus"

    "Modified: / 24.9.1995 / 07:07:33 / claus"

    "Modified: / 5.7.1996 / 17:27:59 / stefan"

    "Modified: / 27.7.1998 / 20:01:56 / cg"

! !

!XPMReader methodsFor:'writing to file'!

colorNameOf:aColor

    "generate a name for a color. If its a standard color,

     return its name; otherwise return the hex representation."

    #(white black red green blue

      yellow magenta cyan orange) do:[:aStandardColorName |

        aColor = (Color name:aStandardColorName) ifTrue:[

            ^ aStandardColorName.

        ]

    ].

    ^ '#' 

     , (aColor redByte hexPrintString:2)

     , (aColor greenByte hexPrintString:2)

     , (aColor blueByte hexPrintString:2)

    "Created: / 27.2.1997 / 11:48:40 / cg"

    "Modified: / 6.6.1998 / 20:58:49 / cg"

!

save:image onFile:aFileName

    "save image as XPM file on aFileName.

     Caveat: currently, only a maximum of roughly 50 colors is handled

             (i.e. very simple images)"

    |usedColors nColorsUsed nColors nChars baseName map maskColorIndex

     isMasked imageMask|

    usedColors := image usedColors asArray.

    nColors := nColorsUsed := usedColors size.

    (imageMask := image mask) notNil ifTrue:[

        nColors := nColors + 1.

        maskColorIndex := nColors.

    ].

    nColors > 256 ifTrue:[

        ^ Image cannotRepresentImageSignal 

            raiseWith:image