"{ Encoding: utf8 }"

"

 COPYRIGHT (c) 1991 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' }"

"{ NameSpace: Smalltalk }"

ImageReader subclass:#GIFReader

	instanceVariableNames:'pass xpos ypos rowByteSize remainBitCount bufByte bufStream

		prefixTable suffixTable clearCode eoiCode freeCode codeSize

		maxCode interlace frameDelay iterationCount leftOffs topOffs'

	classVariableNames:'ImageSeparator Extension Terminator'

	poolDictionaries:''

	category:'Graphics-Images-Readers'

!

!GIFReader class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1991 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 and saving GIF pictures.

    It has been tested with some different GIF87a pictures, I don't

    know, if it works with other GIF versions.

    GIF extension blocks are not handled.

    legal stuff extracted from GIF87a documentation:

    CompuServe Incorporated hereby grants a limited, non-exclusive, royalty-free

    license for the use of the Graphics Interchange Format(sm) in computer

    software; computer software utilizing GIF(sm) must acknowledge ownership of the

    Graphics Interchange Format and its Service Mark by CompuServe Incorporated, in

    User and Technical Documentation.

      The Graphics Interchange Format(c) is the Copyright property of

      CompuServe Incorporated. GIF(sm) is a Service Mark property of

      CompuServe Incorporated.

    Notice:

        there has been some annoyance regarding a patent on the compression algorithm

        used in gif. There is no warranty from exept, regarding any legal problems, when using GIF.

        We therefore highly recommend to use newer (and especially: royalty-free) formats, such as PNG.

        This patent is now obsolete: 

            The United States LZW patent expired on 20 June 2003. 

            The counterpart patents in the United Kingdom, France, Germany and Italy 

            expired on 18 June 2004, the Japanese patents expired on 20 June 2004, 

            and the Canadian patent expired on 7 July 2004.

            Consequently, the GIF format may now be used freely.

    [See also:]

        Image Form Icon

        BlitImageReader FaceReader JPEGReader MacOSXIconReader

        PBMReader PCXReader PNGReader

        ST80FormReader SunRasterReader TargaReader TIFFReader WindowsIconReader

        XBMReader XPMReader XWDReader

    [author:]

        Claus Gittinger

"

!

examples

"

    saving an animated gif sequence:

     a view showing rainfall:

										[exBegin]

    |BG CLR N1 H W v WIND drops gen newDrops draw remove move buffer|

    BG := Color black.

    CLR := Color blue lightened.

    H := 100.

    W := 100.

    N1 := 10.

    WIND := 0.

    drops := OrderedCollection new.

    gen := [:n | ((1 to:n) collect:[:i | Random nextIntegerBetween:1 and:W] as:Set) collect:[:x | x@0]].

    newDrops := [drops addAll:(gen value:N1)].

    draw := [buffer fill:BG; paint:CLR. drops do:[:d | buffer displayPoint:d]].

    remove := [drops := drops reject:[:d | d y > H]].

    move := [:wind | drops := drops collect:[:d| (d x + wind)\\W @ (d y + 1)]].

    v := View new openAndWait.

    buffer := Form extent:(v extent) depth:24 onDevice:v device.

    [

	[v shown] whileTrue:[

	    draw value.

	    v displayForm:buffer.

	    move value:WIND.

	    remove value.

	    newDrops value.

	    WIND := (WIND+(Random nextBetween:-1 and:1)) clampBetween:-5 and:5.

	    Delay waitForSeconds:0.1.

	]

    ] fork.

										[exEnd]

   saving those images:

										[exBegin]

    |seq img BG CLR N1 H W v drops gen gen1 buffer|

    BG := Color black.

    CLR := Color blue lightened.

    H := 100.

    W := 100.

    N1 := 10.

    WIND := 0.

    drops := OrderedCollection new.

    gen := [:n | ((1 to:n) collect:[:i | Random nextIntegerBetween:1 and:W] as:Set) collect:[:x | x@0]].

    newDrops := [drops addAll:(gen value:N1)].

    draw := [buffer fill:BG; paint:CLR. drops do:[:d | buffer displayPoint:d]].

    remove := [drops := drops reject:[:d | d y > H]].

    move := [:wind | drops := drops collect:[:d| (d x + wind)\\W @ (d y + 1)]].

    buffer := Form extent:W@H depth:8 onDevice:Display.

    seq := OrderedCollection new.

    500 timesRepeat:[

	move value:WIND.

	remove value.

	newDrops value.

	draw value.

	seq add:(ImageFrame new delay:100; image:(Depth8Image fromForm:buffer)).

	WIND := (WIND+(Random nextBetween:-1 and:1)) clampBetween:-5 and:5.

    ].

    img := seq first image.

    img imageSequence:(seq copyFrom:2).

    img imageSequence do:[:each | each image colorMap:img colorMap].

    GIFReader save:img onFile:'/tmp/img.gif'

										[exEnd]

"

! !

!GIFReader class methodsFor:'initialization'!

initialize

    "install myself in the Image classes fileFormat table

     for the `.gif' extensions."

    ImageSeparator isNil ifTrue:[

        ImageSeparator := $, codePoint.

        Extension := $!! codePoint.

        Terminator := $; codePoint.

        MIMETypes defineImageType:'image/gif' suffix:'gif' reader:self.

    ].

    "Modified: 14.10.1997 / 18:47:27 / cg"

! !

!GIFReader class methodsFor:'testing'!

canRepresent:anImage

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

     GIF supports depth 8 images only."

    anImage depth == 8 ifTrue:[^ true].

    ('GIFReader [info]: image depth is not 8.') infoPrintCR.

    ^ false.

    "Created: 17.10.1997 / 20:19:20 / cg"

!

isValidImageFile:aFileName

    "return true, if aFileName contains a GIF image"

    |id inStream|

    inStream := self streamReadingFile:aFileName.

    inStream isNil ifTrue:[^ false].

    inStream text.

    id := String new:6.

    inStream nextBytes:6 into:id.

    inStream close.

    (id = 'GIF87a') ifFalse:[

	(id startsWith:'GIF') ifFalse:[^ false].

	id ~= 'GIF89a' ifTrue:[

	    'GIFReader [info]: not a GIF87a/GIF89a file - hope that works' infoPrintCR.

	]

    ].

    ^ true

    "Modified: 10.1.1997 / 15:40:34 / cg"

! !

!GIFReader methodsFor:'image reading'!

fromStream:aStream

    "read a stream containing a GIF image (or an image sequence).

     Leave image description in instance variables."

    |byte flag fileColorMap

     colorMapSize bitsPerPixel scrWidth scrHeight

     hasColorMap interlaced id

     isGif89 atEnd

     img firstImage firstOffset firstFrameDelay frame imageCount|

    inStream := aStream.

    aStream binary.

    "GIF-files are always lsb (intel-world)"

    byteOrder := #lsb.

    id := ByteArray new:6.

    (aStream nextBytes:6 into:id startingAt:1) ~~ 6 ifTrue:[

        ^ self fileFormatError:'not a gif file (short read)'.

    ].

    id := id asString.

    "all I had for testing where GIF87a files;

     I hope later versions work too ..."

    isGif89 := false.

    (id ~= 'GIF87a') ifTrue:[

        (id startsWith:'GIF') ifFalse:[

            ^ self fileFormatError:('not a gif file (id=''' , id , ''')').

        ].

        id ~= 'GIF89a' ifTrue:[

            'GIFReader [info]: not a GIF87a/GIF89a file - hope that works' infoPrintCR.

        ]

    ].

    "get screen dimensions (not used)"

    scrWidth := aStream nextInt16MSB:false.

    scrHeight := aStream nextInt16MSB:false.

    "get flag byte"

    flag := aStream nextByte.

    hasColorMap :=      (flag bitAnd:2r10000000) ~~ 0.

    "bitsPerRGB :=     ((flag bitAnd:2r01110000) bitShift:-4) + 1. "

    "colorMapSorted := ((flag bitAnd:2r00001000) ~~ 0.             "

    bitsPerPixel :=     (flag bitAnd:2r00000111) + 1.

    colorMapSize := 1 bitShift:bitsPerPixel.

    "get background (not used)"

    aStream nextByte.

    "aspect ratio (not used)"

    aStream nextByte.

    "get colorMap"

    hasColorMap ifTrue:[

        fileColorMap := self readColorMap:colorMapSize.

    ].

    colorMap := fileColorMap.

    photometric := #palette.

    samplesPerPixel := 1.

    bitsPerSample := #(8).

    imageCount := 0.

    atEnd := false.

    [atEnd] whileFalse:[

        "gif89a extensions"

        byte := aStream nextByte.

        byte isNil ifTrue:[

            "/ atEnd-Terminator missing

            atEnd := true

        ] ifFalse:[

            byte == Extension ifTrue:[

                "/ 'Ext' infoPrintCR.

                self readExtension:aStream.

            ] ifFalse:[

                (byte == Terminator) ifTrue:[

                    atEnd := true

                ] ifFalse:[

                    "must be image separator"

                    (byte ~~ ImageSeparator) ifTrue:[

                        ^ self fileFormatError:('corrupted gif file (no IMAGESEP): ' , (byte printStringRadix:16)).

                    ].

                    "/ 'Img' infoPrintCR.

                    fileColorMap notNil ifTrue:[

                        colorMap := fileColorMap.

                    ].

                    Object primitiveFailureSignal handle:[:ex |

                        ^ self fileFormatError:('corrupted gif file').

                    ] do:[

                        self readImage:aStream.

                    ].

                    maskPixel notNil ifTrue:[

                        "/

                        "/ ok, there is a maskValue

                        "/ build a Depth1Image for it.

                        "/

                        self buildMaskFromColor:maskPixel

                    ].

                    imageCount == 0 ifTrue:[

                        img := self makeImage.

                        "/ remember first image in case more come later.

                        firstImage := img.

                        firstFrameDelay := frameDelay.

                        firstOffset := (leftOffs @ topOffs).

                    ] ifFalse:[

                        imageCount == 1 ifTrue:[

                            imageSequence := ImageSequence new.

                            img imageSequence:imageSequence.

                            "/ add frame for first image.

                            frame := ImageFrame new image:firstImage.

                            frame delay:firstFrameDelay.

                            frame offset:firstOffset.

                            imageSequence add:frame.

                        ].

                        img := self makeImage.

                        img imageSequence:imageSequence.

                        "/ add frame for this image.

                        frame := ImageFrame new image:img.

                        frame delay:frameDelay.

                        frame offset:(leftOffs @ topOffs).

                        imageSequence add:frame.

                    ].

                    imageCount := imageCount + 1.

                    frameDelay := nil.

                    aStream atEnd ifTrue:[

                        atEnd := true.

                    ]

                ]

            ].

        ].

    ].

    imageSequence notNil ifTrue:[

        iterationCount notNil ifTrue:[

            iterationCount == 0 ifTrue:[

                imageSequence loop:true.

            ] ifFalse:[

                imageSequence loop:false.

                imageSequence iterationCount:iterationCount.

            ]

        ]

    ].

    "

     Image fromFile:'/home/cg/work/stx/goodies/bitmaps/gifImages/animated/vrml.gif'

     Image fromFile:'/home/cg/work/stx/goodies/bitmaps/gifImages/animated/arrow.gif'

    "

    "Modified: / 05-07-1996 / 17:32:01 / stefan"

    "Modified: / 21-08-1998 / 22:20:00 / cg"

    "Modified (format): / 17-02-2017 / 12:29:10 / cg"

! !

!GIFReader methodsFor:'private-reading'!

makeGreyscale

    "not yet implemented/needed"

!

readColorMap:colorMapSize

    "get a gif colormap consisting of colorMapSize entries"

    |rgbVector|

    rgbVector := inStream nextBytes:colorMapSize*3.

    ^ MappedPalette rgbBytesVector:rgbVector

!

readExtension:aStream

    "get gif89 extension"

    |type blockSize subBlockSize

     aspNum aspDen left top width height cWidth cHeight fg bg

     animationType animationTime animationMask

     appID appAUTH

     b ok|

    type := aStream nextByte.

    type == $R codePoint ifTrue:[

        "/

        "/ Ratio extension

        "/

        "/ 'GIFREADER [info]: ratio extension ignored' infoPrintCR.

        blockSize := aStream nextByte.

        (blockSize == 2) ifTrue:[

            aspNum := aStream nextByte.

            aspDen := aStream nextByte

        ] ifFalse:[

            aStream skip:blockSize

        ].

        "/ eat subblocks

        [(subBlockSize := aStream nextByte) > 0] whileTrue:[

            aStream skip:subBlockSize

        ].

        ^ self

    ].

    type == 16r01 ifTrue:[

        "/

        "/ plaintext extension

        "/

        "/ 'GIFREADER [info]: plaintext extension ignored' infoPrintCR.

        subBlockSize := aStream nextByte.

        left := aStream nextInt16MSB:false.

        top := aStream nextInt16MSB:false.

        width := aStream nextInt16MSB:false.

        height := aStream nextInt16MSB:false.

        cWidth := aStream nextByte.

        cHeight := aStream nextByte.

        fg := aStream nextByte.

        bg := aStream nextByte.

        aStream skip:12.

        "/ eat subblocks

        [(subBlockSize := aStream nextByte) > 0] whileTrue:[

            aStream skip:subBlockSize

        ].

        ^ self

    ].

    type == 16rF9 ifTrue:[

        "/

        "/ graphic control extension

        "/

        "/ 'GIFREADER [info]: graphic control extension' infoPrintCR.

        [(subBlockSize := aStream nextByte) ~~ 0 and:[subBlockSize notNil]] whileTrue:[

            "/ type bitAnd:1 means: animationMask is transparent pixel

            "/ to be implemented in Image ...

            animationType := aStream nextByte.

            animationTime := aStream nextInt16MSB:false.

            animationMask := aStream nextByte.

            subBlockSize := subBlockSize - 4.

           (animationType bitTest: 1) ifTrue:[

                maskPixel := animationMask.

"/                'GIFREADER [info]: mask: ' infoPrint. (maskPixel printStringRadix:16) infoPrintCR.

            ].

"/            'GIFREADER [info]: animationTime: ' infoPrint. (animationTime * (1/100)) infoPrintCR.

"/            'GIFREADER [info]: animationType: ' infoPrint. (animationType) infoPrintCR.

"/            'GIFREADER [info]: animationMask: ' infoPrint. (animationMask) infoPrintCR.

            frameDelay := (animationTime * (1/100)) * 1000.

            subBlockSize ~~ 0 ifTrue:[

                aStream skip:subBlockSize

            ].

        ].

        ^ self

    ].

    type == 16rFE ifTrue:[

        "/

        "/ comment extension

        "/

        "/ 'GIFREADER [info]: comment extension' infoPrintCR.

        [(blockSize := aStream nextByte) ~~ 0] whileTrue:[

            aStream skip:blockSize