Squeak-dev May 2022

squeak-dev@lists.squeakfoundation.org

37 participants
316 discussions

Start a nNew thread

corruption after failed project export
by Lauren Pullen 04 May '22

04 May '22

For trunk 21650. See attached. The project failed to export on HandMorph and the UI no longer works.

4 5

The Trunk: Kernel-xw.1463.mcz
by commits＠source.squeak.org 04 May '22

04 May '22

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-xw.1463.mcz ==================== Summary ==================== Name: Kernel-xw.1463 Author: xw Time: 4 May 2022, 9:00:19.605843 pm UUID: 03cc3269-c236-214d-a9e7-f7ee0c914b3d Ancestors: Kernel-nice.1462 Add Unicode support and simplify implementation of CompiledMethod>>#getPreambleFrom:at: =============== Diff against Kernel-nice.1462 =============== Item was changed: ----- Method: CompiledMethod>>getPreambleFrom:at: (in category 'source code management') ----- getPreambleFrom: aFileStream at: endPosition + | chunk | + aFileStream position: endPosition + 2. + [(chunk := aFileStream backChunk) beginsWith: ']lang['] whileTrue. + ^ chunk! - "This method is an ugly hack. This method assumes that source files have ASCII-compatible encoding and that preambles contain no non-ASCII characters." - - | chunkSize chunk | - chunkSize := 160 min: endPosition. - [ - | index | - chunk := aFileStream - position: (endPosition - chunkSize + 1 max: 0); - basicNext: chunkSize. - (index := chunk lastIndexOf: $!! startingAt: chunk size) ~= 0 ifTrue: [ - ^chunk copyFrom: index + 1 to: chunk size ]. - chunkSize := chunkSize * 2. - chunkSize <= endPosition ] whileTrue. - ^chunk!

1 0

The Inbox: Kernel-xw.1463.mcz
by commits＠source.squeak.org 04 May '22

04 May '22

A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-xw.1463.mcz ==================== Summary ==================== Name: Kernel-xw.1463 Author: xw Time: 4 May 2022, 9:00:19.605843 pm UUID: 03cc3269-c236-214d-a9e7-f7ee0c914b3d Ancestors: Kernel-nice.1462 Add Unicode support and simplify implementation of CompiledMethod>>#getPreambleFrom:at: =============== Diff against Kernel-nice.1462 =============== Item was changed: ----- Method: CompiledMethod>>getPreambleFrom:at: (in category 'source code management') ----- getPreambleFrom: aFileStream at: endPosition + | chunk | + aFileStream position: endPosition + 2. + [(chunk := aFileStream backChunk) beginsWith: ']lang['] whileTrue. + ^ chunk! - "This method is an ugly hack. This method assumes that source files have ASCII-compatible encoding and that preambles contain no non-ASCII characters." - - | chunkSize chunk | - chunkSize := 160 min: endPosition. - [ - | index | - chunk := aFileStream - position: (endPosition - chunkSize + 1 max: 0); - basicNext: chunkSize. - (index := chunk lastIndexOf: $!! startingAt: chunk size) ~= 0 ifTrue: [ - ^chunk copyFrom: index + 1 to: chunk size ]. - chunkSize := chunkSize * 2. - chunkSize <= endPosition ] whileTrue. - ^chunk!

2 1

The Trunk: WebClient-Core-mt.130.mcz
by commits＠source.squeak.org 04 May '22

04 May '22

Marcel Taeumel uploaded a new version of WebClient-Core to project The Trunk: http://source.squeak.org/trunk/WebClient-Core-mt.130.mcz ==================== Summary ==================== Name: WebClient-Core-mt.130 Author: mt Time: 20 April 2022, 9:47:40.059048 am UUID: 5c0a8586-880f-9e4c-ab9c-3bcacade9287 Ancestors: WebClient-Core-ct.129 Adds support for cookie field "SameSite". Adds a line break when reporting unknown fields on the Transcript. =============== Diff against WebClient-Core-ct.129 =============== Item was changed: Object subclass: #WebCookie + instanceVariableNames: 'name value path domain expiry version secure httpOnly comment sameSite' - instanceVariableNames: 'name value path domain expiry version secure httpOnly comment' classVariableNames: '' poolDictionaries: '' category: 'WebClient-Core'! !WebCookie commentStamp: 'ar 2/22/2010 05:28' prior: 0! WebCookie represents an http cookie for use by WebClient.! Item was changed: ----- Method: WebCookie>>readFrom: (in category 'initialize') ----- readFrom: aStream "Read a cookie from the given stream" | keyval key val | aStream skipSeparators. name := (aStream upTo: $=) withBlanksTrimmed. value := (aStream upTo: $;) withBlanksTrimmed. [aStream atEnd] whileFalse:[ keyval := aStream upTo: $;. key := (keyval copyUpTo: $=) withBlanksTrimmed. val := (keyval copyAfter: $=) withBlanksTrimmed. key asLowercase caseOf: { ['expires'] -> [self expiry: (self readExpiryFrom: val)]. ['path'] -> [self path: (WebUtils unquote: val)]. ['domain'] -> [self domain: (WebUtils unquote: val)]. ['secure'] -> [self secure: true]. ['version'] -> [self version: val]. ['httponly'] -> [self httpOnly: true]. ['comment'] ->[self comment: val]. ['max-age'] ->[self expirySeconds: val asNumber]. + ['samesite'] -> [self sameSite: val]. + } otherwise:[Transcript showln: 'Unknown cookie field: ', key, ' = ', val]. - } otherwise:[Transcript show: 'Unknown cookie field: ', key]. ].! Item was added: + ----- Method: WebCookie>>sameSite (in category 'accessing') ----- + sameSite + "https://datatracker.ietf.org/doc/html/draft-west-cookie-samesite-firstparty…" + + ^ sameSite! Item was added: + ----- Method: WebCookie>>sameSite: (in category 'accessing') ----- + sameSite: value + + sameSite := value.!

2 1

The Trunk: Morphic-EG.1829.mcz
by commits＠source.squeak.org 04 May '22

04 May '22

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-EG.1829.mcz ==================== Summary ==================== Name: Morphic-EG.1829 Author: EG Time: 21 December 2021, 7:07:54.755803 pm UUID: 92405049-2c0c-4391-a502-53897db173c3 Ancestors: Morphic-mt.1827 This commit represents an overhaul of AnimatedImageMorph, which is now designed to work with the new GIFReadWriter implementaiton. Image forms are composited ahead of time to improve performance and achieve better real world framerates. =============== Diff against Morphic-mt.1827 =============== Item was changed: + (PackageInfo named: 'Morphic') preamble: '"Turn off Morphic drawing because we are refactoring ActiveWorld, ActiveHand, and ActiveEvent." - (PackageInfo named: 'Morphic') preamble: '"Turn off Morphic drawing because we are refactoring ActiveWorld, ActiveHand, and ActiveEvent." Project current world setProperty: #shouldDisplayWorld toValue: false.'! Item was added: + ImageMorph subclass: #AnimatedImageMorph + instanceVariableNames: 'images delays stepTime imageIndex' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Basic'! + + !AnimatedImageMorph commentStamp: 'EG 12/4/2021 12:33' prior: 0! + I am an ImageMorph that can hold more than one image. Each image has its own delay time. I am most commonly created using GIFReaderWriter when it contains multiple images/frames.! Item was added: + ----- Method: AnimatedImageMorph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') ----- + fileReaderServicesForFile: fullName suffix: suffix + + ^((GIFReadWriter typicalFileExtensions asSet + add: '*'; add: 'form'; yourself) + includes: suffix) + ifTrue: [ self services ] + ifFalse: [#()] + ! Item was added: + ----- Method: AnimatedImageMorph class>>fromGIFFileNamed: (in category 'instance creation') ----- + fromGIFFileNamed: fileName + | reader | + reader := GIFReadWriter formsFromFileNamed: fileName. + ^reader forms size = 1 + ifTrue: [ ImageMorph new image: reader forms first ] + ifFalse: [ self new fromGIFReader: reader ]! Item was added: + ----- Method: AnimatedImageMorph class>>fromStream: (in category 'instance creation') ----- + fromStream: aStream + | reader | + reader := GIFReadWriter formsFromStream: aStream. + ^reader forms size = 1 + ifTrue: [ ImageMorph new image: reader forms first ] + ifFalse: [ self new fromGIFReader: reader ]! Item was added: + ----- Method: AnimatedImageMorph class>>initialize (in category 'class initialization') ----- + initialize + "register the receiver in the global registries" + self environment + at: #FileServices + ifPresent: [:cl | cl registerFileReader: self]! Item was added: + ----- Method: AnimatedImageMorph class>>openGIFInWindow: (in category 'instance creation') ----- + openGIFInWindow: aStream + ^(self fromStream: aStream binary) openInWorld! Item was added: + ----- Method: AnimatedImageMorph class>>serviceOpenGIFInWindow (in category 'fileIn/Out') ----- + serviceOpenGIFInWindow + "Answer a service for opening a gif graphic in a window" + ^ (SimpleServiceEntry + provider: self + label: 'open the graphic as a morph' + selector: #openGIFInWindow: + description: 'open a GIF graphic file as a morph' + buttonLabel: 'open') + argumentGetter: [:fileList | fileList readOnlyStream]! Item was added: + ----- Method: AnimatedImageMorph class>>services (in category 'fileIn/Out') ----- + services + ^ Array + with: self serviceOpenGIFInWindow + "with: Form serviceImageImports" + with: Form serviceImageAsBackground! Item was added: + ----- Method: AnimatedImageMorph class>>unload (in category 'class initialization') ----- + unload + "Unload the receiver from global registries" + self environment + at: #FileServices + ifPresent: [:cl | cl unregisterFileReader: self]! Item was added: + ----- Method: AnimatedImageMorph>>addCustomMenuItems:hand: (in category 'stepping and presenter') ----- + addCustomMenuItems: aMenu hand: aHand + super addCustomMenuItems: aMenu hand: aHand. + aMenu addUpdating: #steppingString action: #toggleStepping! Item was added: + ----- Method: AnimatedImageMorph>>composedFormsFromReader: (in category 'frame composition') ----- + composedFormsFromReader: aGIFReader + "Compose a collection of Forms that are composited + from the incoming collection of Frames. We do this instead of + compositing each Form on the fly for performance reasons. + With this method, we can achieve better framerates for + Animated GIFs." + | nextForm compForm | + nextForm := Form extent: (aGIFReader canvasWidth)@(aGIFReader canvasHeight) depth: 32. + ^ aGIFReader frames collect: [ :frame | + frame form displayOn: nextForm at: 0@0 rule: Form paint. + compForm := nextForm copy. + (frame disposal = #leaveCurrent) + ifTrue: [ + nextForm := nextForm copy ]. + (frame disposal = #restoreBackground) + ifTrue: [ + nextForm := Form extent: (aGIFReader canvasWidth)@(aGIFReader canvasHeight) depth: 32 ]. + compForm ] + ! Item was added: + ----- Method: AnimatedImageMorph>>delays (in category 'accessing') ----- + delays + + ^ delays! Item was added: + ----- Method: AnimatedImageMorph>>fromGIFFileNamed: (in category 'private') ----- + fromGIFFileNamed: fileName + self fromReader: (GIFReadWriter formsFromFileNamed: fileName)! Item was added: + ----- Method: AnimatedImageMorph>>fromGIFReader: (in category 'initialization') ----- + fromGIFReader: aGIFReader + delays := aGIFReader delays. + self + stepTime: aGIFReader delays first; + images: (self composedFormsFromReader: aGIFReader); + yourself! Item was added: + ----- Method: AnimatedImageMorph>>fromImages: (in category 'private') ----- + fromImages: anArray + images := anArray. + self setUniformDelay: 10. + imageIndex := 0 + ! Item was added: + ----- Method: AnimatedImageMorph>>fromImages:delay: (in category 'private') ----- + fromImages: anArray delay: anInteger + images := anArray. + self setUniformDelay: anInteger.! Item was added: + ----- Method: AnimatedImageMorph>>fromStream: (in category 'private') ----- + fromStream: aStream + self fromGIFReader: (GIFReadWriter formsFromStream: aStream)! Item was added: + ----- Method: AnimatedImageMorph>>fromUrl: (in category 'initialization') ----- + fromUrl: aUrl + | request | + request := WebClient httpDo: [ :client | client httpGet: aUrl ]. + (request code = 200) not ifTrue: [ Error signal: 'Bad URL or Request' ]. + ((request headerAt: 'Content-Type') = 'image/gif') not + ifTrue: [ Error signal: 'Url does not respond with a gif, but a ', (request headerAt: 'Content-Type')]. + ^ self fromStream: request content asByteArray readStream.! Item was added: + ----- Method: AnimatedImageMorph>>images (in category 'private') ----- + images + ^images! Item was added: + ----- Method: AnimatedImageMorph>>images: (in category 'accessing') ----- + images: aCollectionOfForms + images := aCollectionOfForms! Item was added: + ----- Method: AnimatedImageMorph>>initialize (in category 'private') ----- + initialize + imageIndex := 1. + stepTime := 10. + super initialize! Item was added: + ----- Method: AnimatedImageMorph>>reset (in category 'private') ----- + reset + imageIndex := 1. + self image: (Form extent: self maxImagesExtent depth: 32).! Item was added: + ----- Method: AnimatedImageMorph>>setStepping: (in category 'stepping and presenter') ----- + setStepping: aBoolean + self wantsSteps ifFalse:[^false]. + aBoolean ifTrue:[self startStepping] + ifFalse:[self stopStepping].! Item was added: + ----- Method: AnimatedImageMorph>>setUniformDelay: (in category 'private') ----- + setUniformDelay: anInteger + "set delay to a uniform value for all images" + delays := Array new: images size withAll: anInteger.! Item was added: + ----- Method: AnimatedImageMorph>>step (in category 'stepping and presenter') ----- + step + ((imageIndex + 1) >= images size) + ifTrue: [ imageIndex := 1 ] + ifFalse: [ imageIndex := imageIndex + 1 ]. + self + stepTime: (delays at: imageIndex); + image: (images at: imageIndex) + ! Item was added: + ----- Method: AnimatedImageMorph>>stepTime (in category 'stepping and presenter') ----- + stepTime + ^stepTime ifNil: [super stepTime]! Item was added: + ----- Method: AnimatedImageMorph>>stepTime: (in category 'stepping and presenter') ----- + stepTime: anInteger + stepTime := anInteger! Item was added: + ----- Method: AnimatedImageMorph>>steppingString (in category 'stepping and presenter') ----- + steppingString + ^ (self isStepping + ifTrue: ['<on>'] + ifFalse: ['<off>']), 'stepping' translated! Item was added: + ----- Method: AnimatedImageMorph>>toggleStepping (in category 'stepping and presenter') ----- + toggleStepping + self wantsSteps + ifTrue: [ + self isStepping + ifFalse: [self startStepping] + ifTrue: [self stopStepping]]! Item was added: + ----- Method: AnimatedImageMorph>>wantsSteps (in category 'stepping and presenter') ----- + wantsSteps + ^(images size > 1) + !

1 0

The Trunk: Graphics-EG.453.mcz
by commits＠source.squeak.org 04 May '22

04 May '22

Marcel Taeumel uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-EG.453.mcz ==================== Summary ==================== Name: Graphics-EG.453 Author: EG Time: 21 December 2021, 7:02:54.767997 pm UUID: 23680343-cadd-4d79-96d3-f7e739d9f8d5 Ancestors: Graphics-mt.452 This commit represents a reimplementation of GIF file parsing. Previously, GIF decoding was not implemented correctly, and many GIFs would not display. The new GIFReadWriter properly handles the GIF spec and treats all GIF images as (potentially) a series of image frames, using the utility class AnimatedImageFrame. Additionally, GIFReadWriter breaks out the LZW encoding/decoding into utility classes, respectively named LzeGIFEncoder/Decoder. I have gone ahead and deprecated AnimatedGIFReadWriter, since the reading of animated GIFs is now a normal part of the regular file reading process. =============== Diff against Graphics-mt.452 =============== Item was added: + ----- Method: AnimatedGIFReadWriter class>>basicNew (in category 'as yet unclassified') ----- + basicNew + "Notify that the class is being deprecated." + self deprecated: 'This class is deprecated. Its functionality can be found in the regular GIFReadWriter class instead.'. + ^ super basicNew + ! Item was changed: ----- Method: AnimatedGIFReadWriter class>>typicalFileExtensions (in category 'image reading/writing') ----- typicalFileExtensions "Answer a collection of file extensions (lowercase) which files that I can read might commonly have" + ^#()! - ^#('gif')! Item was changed: ----- Method: AnimatedGIFReadWriter class>>wantsToHandleGIFs (in category 'image reading/writing') ----- wantsToHandleGIFs + ^ false! - ^true! Item was added: + Object subclass: #AnimatedImageFrame + instanceVariableNames: 'form delay disposal offset interlace' + classVariableNames: '' + poolDictionaries: '' + category: 'Graphics-Files'! + + !AnimatedImageFrame commentStamp: '' prior: 0! + I am a single frame in a sequence of frames that comprise an animated image. I am designed for use by classes like AnimatedImageMorph and am created during the reading of some image files such as GIFs (see GIFReadWriter). + + I contain a Form describing my image, a delay time in milliseconds that describes how long I should be displayed in a sequence of animated frames, and a disposal symbol that implementors can use when compositing myself in a sequence of frames. + + See AnimatedImageMorph for examples of how I am used.! Item was added: + ----- Method: AnimatedImageFrame>>defaultDelay (in category 'defaults') ----- + defaultDelay + ^ 66! Item was added: + ----- Method: AnimatedImageFrame>>delay (in category 'accessing') ----- + delay + ^ delay! Item was added: + ----- Method: AnimatedImageFrame>>delay: (in category 'accessing') ----- + delay: aNumber + delay := aNumber! Item was added: + ----- Method: AnimatedImageFrame>>disposal (in category 'accessing') ----- + disposal + ^ disposal! Item was added: + ----- Method: AnimatedImageFrame>>disposal: (in category 'accessing') ----- + disposal: aSymbol + "Disposal must be one of: + #restoreBackground + #leaveCurrent + #restorePreviousState" + "({ #restoreBackground. + #leaveCurrent. + #restorePreviousState } includes: aSymbol) ifTrue: [ + disposal := aSymbol ]." + disposal := aSymbol! Item was added: + ----- Method: AnimatedImageFrame>>form (in category 'accessing') ----- + form + ^ form! Item was added: + ----- Method: AnimatedImageFrame>>form: (in category 'accessing') ----- + form: aForm + form := aForm! Item was added: + ----- Method: AnimatedImageFrame>>initialize (in category 'initialization') ----- + initialize + super initialize. + offset := 0 @ 0. + delay := self defaultDelay. + disposal := #otherDisposal. + interlace := false! Item was added: + ----- Method: AnimatedImageFrame>>interlace (in category 'accessing') ----- + interlace + ^ interlace! Item was added: + ----- Method: AnimatedImageFrame>>interlace: (in category 'accessing') ----- + interlace: aBoolean + interlace := aBoolean! Item was added: + ----- Method: AnimatedImageFrame>>offset (in category 'accessing') ----- + offset + ^ offset! Item was added: + ----- Method: AnimatedImageFrame>>offset: (in category 'accessing') ----- + offset: aPoint + "This represents the frame form's offset in the + parent image canvas" + offset := aPoint! Item was changed: ImageReadWriter subclass: #GIFReadWriter + instanceVariableNames: 'width height bitsPerPixel colorPalette rowByteSize xpos ypos pass interlace transparentIndex localColorTable loopCount offset frames canvasWidth canvasHeight backgroundColorIndex comment' - instanceVariableNames: 'width height bitsPerPixel colorPalette rowByteSize xpos ypos pass interlace codeSize clearCode eoiCode freeCode maxCode prefixTable suffixTable remainBitCount bufByte bufStream transparentIndex mapOf32 localColorTable delay loopCount offset' classVariableNames: 'Extension ImageSeparator Terminator' poolDictionaries: '' category: 'Graphics-Files'! + !GIFReadWriter commentStamp: '' prior: 0! + I am GIFReadWriter. + I am a concrete ImageReadWriter. - !GIFReadWriter commentStamp: '<historical>' prior: 0! - Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved. + Updated implementation of a GIF file (byte-level) decoder. + + I implment a Stream-like behavior over a GIF image file, and can both read and write GIF files. + + Previously, two classes distinguished between "still" and "animated" GIFs. However, the standard specifies that any GIF can have "frames" and be animated. This reimplementation treats this as normal. + + See these links for more detailed information: + + https://www.w3.org/Graphics/GIF/spec-gif89a.txt + https://en.wikipedia.org/wiki/GIF + http://www.matthewflickinger.com/lab/whatsinagif/bits_and_bytes.asp + + For writing GIF files, I take a collection of AnimatedImageFrame objects and write the appropriate headers, Graphics Control Extensions, and everything else needed for writing an animated GIF. + + For reading GIF files, I take a binary filestream and set my own `frames` variable to be a collection of AnimatedImageFrames, which themselves contain decoded Forms and instructions for disposal, delay, etc. + + NOTE: I make use of the LzwGifDecoder and LzwGifEncoder classes in order to encode/decode individual bitmap data for each image frame of the GIF. + + See `GIFReadWriter exampleAnim` for more information. ! - Used with permission. Modified for use in Squeak.! Item was changed: ----- Method: GIFReadWriter class>>exampleAnim (in category 'examples') ----- exampleAnim + "This example writes out an animated gif of + a red circle" - "GIFReadWriter exampleAnim" + | writer extent center frameDelay | + writer := GIFReadWriter on: (FileStream fileNamed: 'anim.gif'). - | writer extent center | - writer := GIFReadWriter on: (FileStream newFileNamed: 'anim.gif'). writer loopCount: 20. "Repeat 20 times" + frameDelay := 10. "Wait 10/100 seconds" - writer delay: 10. "Wait 10/100 seconds" extent := 42@42. center := extent / 2. Cursor write showWhile: [ [2 to: center x - 1 by: 2 do: [:r | "Make a fancy anim without using Canvas - inefficient as hell" + | frame | + frame := AnimatedImageFrame new + delay: frameDelay; + form: (ColorForm extent: extent depth: 8). + 0.0 to: 359.0 do: [:theta | frame form colorAt: (center + (Point r: r degrees: theta)) rounded put: Color red]. + writer nextPutFrame: frame ] - | image | - image := ColorForm extent: extent depth: 8. - 0.0 to: 359.0 do: [:theta | image colorAt: (center + (Point r: r degrees: theta)) rounded put: Color red]. - writer nextPutImage: image] ] ensure: [writer close]].! Item was added: + ----- Method: GIFReadWriter class>>formsFromFileNamed: (in category 'as yet unclassified') ----- + formsFromFileNamed: aFile + ^ (self on: aFile asDirectoryEntry readStream binary) + readHeader; + readBody; + yourself! Item was added: + ----- Method: GIFReadWriter class>>formsFromStream: (in category 'as yet unclassified') ----- + formsFromStream: aBinaryStream + ^ (self on: aBinaryStream) + readHeader; + readBody; + yourself! Item was changed: ----- Method: GIFReadWriter class>>grabScreenAndSaveOnDisk (in category 'examples') ----- grabScreenAndSaveOnDisk "GIFReadWriter grabScreenAndSaveOnDisk" | form fileName | form := Form fromUser. form bits size = 0 ifTrue: [^Beeper beep]. fileName := FileDirectory default nextNameFor: 'Squeak' extension: 'gif'. UIManager default informUser: 'Writing ' , fileName during: [GIFReadWriter putForm: form onFileNamed: fileName]! Item was changed: + ----- Method: GIFReadWriter class>>initialize (in category 'initialization') ----- - ----- Method: GIFReadWriter class>>initialize (in category 'class initialization') ----- initialize "GIFReadWriter initialize" - ImageSeparator := $, asInteger. Extension := $!! asInteger. + Terminator := $; asInteger! - Terminator := $; asInteger. - ! Item was changed: ----- Method: GIFReadWriter class>>typicalFileExtensions (in category 'image reading/writing') ----- typicalFileExtensions "Answer a collection of file extensions (lowercase) which files that I can read might commonly have" + ^ self allSubclasses + detect: [ :cls | cls wantsToHandleGIFs ] + ifFound: [ #() ] + ifNone: [ + "if none of my subclasses wants , then i''ll have to do" + #('gif') ]! - self - allSubclasses detect: [:cls | cls wantsToHandleGIFs ] - ifNone: ["if none of my subclasses wants , then i''ll have to do" - ^ #('gif' )]. - ^ #( )! Item was changed: ----- Method: GIFReadWriter class>>wantsToHandleGIFs (in category 'image reading/writing') ----- wantsToHandleGIFs + ^ true! - ^ false! Item was added: + ----- Method: GIFReadWriter>>backgroundColor (in category 'accessing') ----- + backgroundColor + backgroundColorIndex ifNotNil: [ + colorPalette ifNotNil: [ + ^ colorPalette at: backgroundColorIndex + 1]]. + ^ Color transparent.! Item was added: + ----- Method: GIFReadWriter>>canvasHeight (in category 'accessing') ----- + canvasHeight + ^ canvasHeight! Item was added: + ----- Method: GIFReadWriter>>canvasHeight: (in category 'accessing') ----- + canvasHeight: aNumber + canvasHeight := aNumber! Item was added: + ----- Method: GIFReadWriter>>canvasWidth (in category 'accessing') ----- + canvasWidth + ^ canvasWidth! Item was added: + ----- Method: GIFReadWriter>>canvasWidth: (in category 'accessing') ----- + canvasWidth: aNumber + canvasWidth := aNumber! Item was removed: - ----- Method: GIFReadWriter>>checkCodeSize (in category 'private') ----- - checkCodeSize - (freeCode > maxCode and: [codeSize < 12]) - ifTrue: - [codeSize := codeSize + 1. - maxCode := (1 bitShift: codeSize) - 1]! Item was added: + ----- Method: GIFReadWriter>>close (in category 'stream access') ----- + close + "A read close" + ^super close! Item was added: + ----- Method: GIFReadWriter>>delays (in category 'accessing') ----- + delays + "Respond with an ordered collection of Frame delay values" + ^ frames collect: [ :frame | frame delay ]! Item was removed: - ----- Method: GIFReadWriter>>fillBuffer (in category 'private-packing') ----- - fillBuffer - | packSize | - packSize := self next. - bufStream := ReadStream on: (self next: packSize)! Item was removed: - ----- Method: GIFReadWriter>>flushBits (in category 'private-bits access') ----- - flushBits - remainBitCount = 0 ifFalse: - [self nextBytePut: bufByte. - remainBitCount := 0]. - self flushBuffer! Item was removed: - ----- Method: GIFReadWriter>>flushBuffer (in category 'private-packing') ----- - flushBuffer - bufStream isEmpty ifTrue: [^self]. - self nextPut: bufStream size. - self nextPutAll: bufStream contents. - bufStream := WriteStream on: (ByteArray new: 256)! Item was removed: - ----- Method: GIFReadWriter>>flushCode (in category 'private-encoding') ----- - flushCode - self flushBits! Item was added: + ----- Method: GIFReadWriter>>form (in category 'accessing') ----- + form + "By default, answer with the first Form available in the + ImageFrames collection. If there are not any frames, answer nil" + frames ifNil: [ ^ nil ]. + frames ifEmpty: [ ^ nil ]. + ^ frames first form.! Item was added: + ----- Method: GIFReadWriter>>forms (in category 'accessing') ----- + forms + frames ifNil: [ ^ nil ]. + ^ frames collect: [ :f | f form ].! Item was added: + ----- Method: GIFReadWriter>>frames (in category 'accessing') ----- + frames + ^ frames! Item was added: + ----- Method: GIFReadWriter>>frames: (in category 'accessing') ----- + frames: aCollectionOfImageFrames + "Set the receiver's underlying collection of + ImageFrame objects. Used when attempting to write + out GIF images" + frames := aCollectionOfImageFrames! Item was added: + ----- Method: GIFReadWriter>>isAnimated (in category 'testing') ----- + isAnimated + frames ifNil: [ ^ false ]. + ^ frames size > 1! Item was changed: ----- Method: GIFReadWriter>>loopCount: (in category 'accessing') ----- loopCount: aNumber "Set looping. This must be done before any image is written!!" loopCount := aNumber! Item was removed: - ----- Method: GIFReadWriter>>nextBits (in category 'private-bits access') ----- - nextBits - | integer readBitCount shiftCount byte | - integer := 0. - remainBitCount = 0 - ifTrue: - [readBitCount := 8. - shiftCount := 0] - ifFalse: - [readBitCount := remainBitCount. - shiftCount := remainBitCount - 8]. - [readBitCount < codeSize] - whileTrue: - [byte := self nextByte. - byte == nil ifTrue: [^eoiCode]. - integer := integer + (byte bitShift: shiftCount). - shiftCount := shiftCount + 8. - readBitCount := readBitCount + 8]. - (remainBitCount := readBitCount - codeSize) = 0 - ifTrue: [byte := self nextByte] - ifFalse: [byte := self peekByte]. - byte == nil ifTrue: [^eoiCode]. - ^(integer + (byte bitShift: shiftCount)) bitAnd: maxCode! Item was removed: - ----- Method: GIFReadWriter>>nextBitsPut: (in category 'private-bits access') ----- - nextBitsPut: anInteger - | integer writeBitCount shiftCount | - shiftCount := 0. - remainBitCount = 0 - ifTrue: - [writeBitCount := 8. - integer := anInteger] - ifFalse: - [writeBitCount := remainBitCount. - integer := bufByte + (anInteger bitShift: 8 - remainBitCount)]. - [writeBitCount < codeSize] - whileTrue: - [self nextBytePut: ((integer bitShift: shiftCount) bitAnd: 255). - shiftCount := shiftCount - 8. - writeBitCount := writeBitCount + 8]. - (remainBitCount := writeBitCount - codeSize) = 0 - ifTrue: [self nextBytePut: (integer bitShift: shiftCount)] - ifFalse: [bufByte := integer bitShift: shiftCount]. - ^anInteger! Item was removed: - ----- Method: GIFReadWriter>>nextByte (in category 'private-packing') ----- - nextByte - bufStream atEnd - ifTrue: - [self atEnd ifTrue: [^nil]. - self fillBuffer]. - ^bufStream next! Item was removed: - ----- Method: GIFReadWriter>>nextBytePut: (in category 'private-packing') ----- - nextBytePut: aByte - bufStream nextPut: aByte. - bufStream size >= 254 ifTrue: [self flushBuffer]! Item was changed: ----- Method: GIFReadWriter>>nextImage (in category 'accessing') ----- nextImage + "This method ensures older compatibility with ImageReadWriter. + We respond with the Form corresponding to the *first image* on + the receiver's read byte stream" + self + readHeader; + readBody. + ^ self form.! - "Read in the next GIF image from the stream." - - | f thisImageColorTable | - - localColorTable := nil. - self readHeader. - f := self readBody. - self close. - f == nil ifTrue: [^ self error: 'corrupt GIF file']. - - thisImageColorTable := localColorTable ifNil: [colorPalette]. - transparentIndex ifNotNil: [ - transparentIndex + 1 > thisImageColorTable size ifTrue: [ - thisImageColorTable := thisImageColorTable - forceTo: transparentIndex + 1 - paddingWith: Color white - ]. - thisImageColorTable at: transparentIndex + 1 put: Color transparent - ]. - f colors: thisImageColorTable. - ^ f - ! Item was added: + ----- Method: GIFReadWriter>>nextPutFrame: (in category 'accessing') ----- + nextPutFrame: anAnimatedImageFrame + "Given the current settings, write the bytes onto the + output stream for the given ImageFrame and its form" + | aForm reduced tempForm tempFrame | + + aForm := anAnimatedImageFrame form copy. + aForm unhibernate. + aForm depth > 8 ifTrue:[ + reduced := aForm colorReduced. "minimize depth" + reduced depth > 8 ifTrue: [ + "Not enough color space; do it the hard way." + reduced := reduced asFormOfDepth: 8]. + ] ifFalse:[reduced := aForm]. + reduced depth < 8 ifTrue: [ + "writeBitData: expects depth of 8" + tempForm := reduced class extent: reduced extent depth: 8. + (reduced isColorForm) ifTrue:[ + tempForm + copyBits: reduced boundingBox + from: reduced at: 0@0 + clippingBox: reduced boundingBox + rule: Form over + fillColor: nil + map: nil. + tempForm colors: reduced colors. + ] ifFalse: [reduced displayOn: tempForm]. + reduced := tempForm. + ]. + (reduced isColorForm) ifTrue:[ + (reduced colorsUsed includes: Color transparent) ifTrue: [ + transparentIndex := (reduced colors indexOf: Color transparent) - 1. + ] + ] ifFalse: [transparentIndex := nil]. + width := reduced width. + height := reduced height. + bitsPerPixel := reduced depth. + colorPalette := reduced colormapIfNeededForDepth: 32. + interlace := false. + tempFrame := AnimatedImageFrame new + form: reduced; + offset: anAnimatedImageFrame offset; + delay: anAnimatedImageFrame delay; + disposal: anAnimatedImageFrame disposal. + self writeHeader. + self writeFrameHeader: tempFrame. + self writeBitData: reduced bits.! Item was changed: ----- Method: GIFReadWriter>>nextPutImage: (in category 'accessing') ----- nextPutImage: aForm + "Given the current settings, write the bytes onto the + output stream for the given ImageFrame and its form" + | reduced tempForm tempFrame | + - - | reduced tempForm | aForm unhibernate. aForm depth > 8 ifTrue:[ reduced := aForm colorReduced. "minimize depth" reduced depth > 8 ifTrue: [ "Not enough color space; do it the hard way." reduced := reduced asFormOfDepth: 8]. ] ifFalse:[reduced := aForm]. reduced depth < 8 ifTrue: [ "writeBitData: expects depth of 8" + tempForm := reduced class extent: reduced extent depth: 8. - tempForm := reduced species extent: reduced extent depth: 8. (reduced isColorForm) ifTrue:[ tempForm copyBits: reduced boundingBox from: reduced at: 0@0 clippingBox: reduced boundingBox rule: Form over fillColor: nil map: nil. tempForm colors: reduced colors. ] ifFalse: [reduced displayOn: tempForm]. reduced := tempForm. ]. (reduced isColorForm) ifTrue:[ (reduced colorsUsed includes: Color transparent) ifTrue: [ transparentIndex := (reduced colors indexOf: Color transparent) - 1. ] ] ifFalse: [transparentIndex := nil]. width := reduced width. height := reduced height. bitsPerPixel := reduced depth. colorPalette := reduced colormapIfNeededForDepth: 32. interlace := false. + tempFrame := AnimatedImageFrame new + form: reduced; + offset: reduced offset. self writeHeader. + self writeFrameHeader: tempFrame. + self writeBitData: reduced bits.! - self writeBitData: reduced bits. - ! Item was removed: - ----- Method: GIFReadWriter>>peekByte (in category 'private-packing') ----- - peekByte - bufStream atEnd - ifTrue: - [self atEnd ifTrue: [^nil]. - self fillBuffer]. - ^bufStream peek! Item was added: + ----- Method: GIFReadWriter>>processColorsFor: (in category 'private - decoding') ----- + processColorsFor: anImageFrame + "Colors can only be mapped after the GCE has been evaluated + for a given image frame. We perform this action using either + the local or global color table for this frame's form" + | colorTable | + colorTable := localColorTable ifNil: [ colorPalette ]. + + "Use a copy so we don't mess up the global color table as we parse" + colorTable := colorTable copyFrom: 1 to: colorTable size. + + transparentIndex + ifNotNil: [ + transparentIndex + 1 > colorTable size + ifTrue: [ + colorTable := colorTable + forceTo: transparentIndex + 1 + paddingWith: Color white ]. + colorTable + at: transparentIndex + 1 + put: Color transparent ]. + anImageFrame form colors: colorTable.! Item was added: + ----- Method: GIFReadWriter>>readApplicationExtension (in category 'private - decoding') ----- + readApplicationExtension + "Uses the underlying stream to read a so-called + Application Extension to the GIF Image. These extensions + are at the whole file -- not individual frame like a GCE -- + level. It appears the only kind widely used is the NETSCAPE + extension for determining the number of times an animated + GIF should loop." + | bytesFollow appName appAuthCode caughtInfo numSubBlocks loopVal1 loopVal2 | + "How many bytes before data begins? + Usually 11" + bytesFollow := self next. + appName := (String streamContents: [ :s | + 1 to: 8 do: [ :num | + s + nextPut: self next asCharacter ] ]). + appAuthCode := (String streamContents: [ :s | + 1 to: 3 do: [ :num | + s + nextPut: self next asCharacter ] ]). + caughtInfo := (appName size + appAuthCode size). + caughtInfo = bytesFollow ifFalse: [ + (bytesFollow = caughtInfo) timesRepeat: [ + self next ] ]. + numSubBlocks := self next. + appName = 'NETSCAPE' + ifTrue: [ + self next. "Data sub-block index (always 1)" + "If it's the NETSCAPE extension, the next + byte will set the loopCount. This is stored in + a 2-byte lo-hi unsigned format" + loopVal1 := self next. + loopVal2 := self next. + loopCount := (loopVal2 * 256) + loopVal1. + self next = 0 ifFalse: [ ^ self error: 'Corrupt NETSCAPE Application Block' ]. + ^ self ]. + + "For now we ignore Application Extensions + that are not the NETSCAPE kind" + [ numSubBlocks = 0 ] whileFalse: [ + self next: numSubBlocks. + numSubBlocks := self next ]. + ! Item was removed: - ----- Method: GIFReadWriter>>readBitData (in category 'private-decoding') ----- - readBitData - "using modified Lempel-Ziv Welch algorithm." - - | outCodes outCount bitMask initCodeSize code curCode oldCode inCode finChar i bytes f c packedBits hasLocalColor localColorSize maxOutCodes | - - maxOutCodes := 4096. - offset := self readWord@self readWord. "Image Left@Image Top" - width := self readWord. - height := self readWord. - - "--- - Local Color Table Flag 1 Bit - Interlace Flag 1 Bit - Sort Flag 1 Bit - Reserved 2 Bits - Size of Local Color Table 3 Bits - ----" - packedBits := self next. - interlace := (packedBits bitAnd: 16r40) ~= 0. - hasLocalColor := (packedBits bitAnd: 16r80) ~= 0. - localColorSize := 1 bitShift: ((packedBits bitAnd: 16r7) + 1). - hasLocalColor ifTrue: [localColorTable := self readColorTable: localColorSize]. - - pass := 0. - xpos := 0. - ypos := 0. - rowByteSize := ((width + 3) // 4) * 4. - remainBitCount := 0. - bufByte := 0. - bufStream := ReadStream on: ByteArray new. - - outCodes := ByteArray new: maxOutCodes + 1. - outCount := 0. - bitMask := (1 bitShift: bitsPerPixel) - 1. - prefixTable := Array new: 4096. - suffixTable := Array new: 4096. - - initCodeSize := self next. - - self setParameters: initCodeSize. - bitsPerPixel > 8 ifTrue: [^self error: 'never heard of a GIF that deep']. - bytes := ByteArray new: rowByteSize * height. - [(code := self readCode) = eoiCode] whileFalse: - [code = clearCode - ifTrue: - [self setParameters: initCodeSize. - curCode := oldCode := code := self readCode. - finChar := curCode bitAnd: bitMask. - "Horrible hack to avoid running off the end of the bitmap. Seems to cure problem reading some gifs!!? tk 6/24/97 20:16" - xpos = 0 ifTrue: [ - ypos < height ifTrue: [ - bytes at: (ypos * rowByteSize) + xpos + 1 put: finChar]] - ifFalse: [bytes at: (ypos * rowByteSize) + xpos + 1 put: finChar]. - self updatePixelPosition] - ifFalse: - [curCode := inCode := code. - curCode >= freeCode ifTrue: - [curCode := oldCode. - outCodes at: (outCount := outCount + 1) put: finChar]. - [curCode > bitMask] whileTrue: - [outCount > maxOutCodes - ifTrue: [^self error: 'corrupt GIF file (OutCount)']. - outCodes at: (outCount := outCount + 1) - put: (suffixTable at: curCode + 1). - curCode := prefixTable at: curCode + 1]. - finChar := curCode bitAnd: bitMask. - outCodes at: (outCount := outCount + 1) put: finChar. - i := outCount. - [i > 0] whileTrue: - ["self writePixel: (outCodes at: i) to: bits" - bytes at: (ypos * rowByteSize) + xpos + 1 put: (outCodes at: i). - self updatePixelPosition. - i := i - 1]. - outCount := 0. - prefixTable at: freeCode + 1 put: oldCode. - suffixTable at: freeCode + 1 put: finChar. - oldCode := inCode. - freeCode := freeCode + 1. - self checkCodeSize]]. - prefixTable := suffixTable := nil. - - f := ColorForm extent: width@height depth: 8. - f bits copyFromByteArray: bytes. - "Squeak can handle depths 1, 2, 4, and 8" - bitsPerPixel > 4 ifTrue: [^ f]. - "reduce depth to save space" - c := ColorForm extent: width@height - depth: (bitsPerPixel = 3 ifTrue: [4] ifFalse: [bitsPerPixel]). - f displayOn: c. - ^ c - ! Item was added: + ----- Method: GIFReadWriter>>readBitDataOnFrame: (in category 'private - decoding') ----- + readBitDataOnFrame: aFrame + "using modified Lempel-Ziv Welch algorithm." + | initCodeSize packedBits hasLocalColor localColorSize maxOutCodes decoder c bytes | + maxOutCodes := 4096. + offset := self readWord @ self readWord. "Image Left@Image Top" + width := self readWord. + height := self readWord. + "--- + Local Color Table Flag 1 Bit + Interlace Flag 1 Bit + Sort Flag 1 Bit + Reserved 2 Bits + Size of Local Color Table 3 Bits + ----" + packedBits := self next. + interlace := (packedBits bitAnd: 64) ~= 0. + aFrame interlace: interlace. + hasLocalColor := (packedBits bitAnd: 128) ~= 0. + localColorSize := 1 bitShift: (packedBits bitAnd: 7) + 1. + hasLocalColor + ifTrue: [ + localColorTable := self readColorTable: localColorSize ] + ifFalse: [ localColorTable := nil ]. + pass := 0. + xpos := 0. + ypos := 0. + rowByteSize := (width + 3) // 4 * 4. + bytes := (ByteArray new: rowByteSize * height). + + initCodeSize := self next. + + c := ColorForm + extent: width@height + depth: 8. + + decoder := LzwGifDecoder new. + decoder + codeStream: stream; + minimumCodeSize: initCodeSize; + maxCode: maxOutCodes; + onDecodedBit: [ :bit | + bytes + at: (ypos * rowByteSize + xpos + 1) + put: bit. + self updatePixelPosition ]. + decoder decode. + c bits copyFromByteArray: bytes. + ^ c! Item was changed: + ----- Method: GIFReadWriter>>readBody (in category 'private - decoding') ----- - ----- Method: GIFReadWriter>>readBody (in category 'private-decoding') ----- readBody + "Read the GIF blocks. Modified to return a frame." + | block frame | + frame := nil. + frames := OrderedCollection new. + [ stream atEnd ] whileFalse: [ - "Read the GIF blocks. Modified to return a form. " - - | form extype block blocksize packedFields delay1 | - form := nil. - [stream atEnd] whileFalse: [ block := self next. + + "If we have reached the terminator byte, return." + block = Terminator ifTrue: [ ^ frame ]. + block = ImageSeparator + ifTrue: [ + frame ifNil: [ frame := AnimatedImageFrame new ]. + frame form: (self readBitDataOnFrame: frame). "Adjusting message for testing" + frame offset: offset. "Set from instance var, which is set in readBitData" + frame form offset: offset. "Set the offset on the underlying Form as well" + + frames add: frame. + self processColorsFor: frame. + frame := nil. ] + ifFalse: + [ "If it's not actual image data, perhaps + it's an Extension of some kind (there can be several)" + block = Extension + ifTrue: [ + frame ifNil: [ frame := AnimatedImageFrame new ]. + self readExtensionBlock: block withFrame: frame ] + ifFalse: [ ^ self error: 'Unknown Bytes!!' ] ] + ]. + ^ frames.! - block = Terminator ifTrue: [^ form]. - block = ImageSeparator ifTrue: [ - form isNil - ifTrue: [form := self readBitData] - ifFalse: [self skipBitData]. - ] ifFalse: [ - block = Extension - ifFalse: [^ form "^ self error: 'Unknown block type'"]. - "Extension block" - extype := self next. "extension type" - extype = 16rF9 ifTrue: [ "graphics control" - self next = 4 ifFalse: [^ form "^ self error: 'corrupt GIF file'"]. - "==== - Reserved 3 Bits - Disposal Method 3 Bits - User Input Flag 1 Bit - Transparent Color Flag 1 Bit - ===" - - packedFields := self next. - delay1 := self next. "delay time 1" - delay := (self next*256 + delay1) *10. "delay time 2" - transparentIndex := self next. - (packedFields bitAnd: 1) = 0 ifTrue: [transparentIndex := nil]. - self next = 0 ifFalse: [^ form "^ self error: 'corrupt GIF file'"]. - ] ifFalse: [ - "Skip blocks" - [(blocksize := self next) > 0] - whileTrue: [ - "Read the block and ignore it and eat the block terminator" - self next: blocksize]]]]. - ^nil! Item was removed: - ----- Method: GIFReadWriter>>readCode (in category 'private-decoding') ----- - readCode - ^self nextBits! Item was changed: + ----- Method: GIFReadWriter>>readColorTable: (in category 'private - decoding') ----- + readColorTable: numberOfEntries - ----- Method: GIFReadWriter>>readColorTable: (in category 'private-decoding') ----- - readColorTable: numberOfEntries - | array r g b | - array := Array new: numberOfEntries. + 1 + to: array size + do: + [ :i | + r := self next. + g := self next. + b := self next. + array + at: i + put: (Color + r: r + g: g + b: b + range: 255) ]. + ^ array! - 1 to: array size do: [ :i | - r := self next. - g := self next. - b := self next. - array at: i put: (Color r: r g: g b: b range: 255) - ]. - ^array! Item was added: + ----- Method: GIFReadWriter>>readCommentExtension (in category 'private - decoding') ----- + readCommentExtension + | blockTerminator | + blockTerminator := self next. + blockTerminator > 0 + ifTrue: [ comment := self next: blockTerminator. + blockTerminator := self next ]. + blockTerminator = 0 + ifFalse: [ ^ self error: 'Invalid Block Terminator' ]! Item was added: + ----- Method: GIFReadWriter>>readDisposal: (in category 'private - decoding') ----- + readDisposal: aPackedByte + "Read the three-bit disposal flag from + the packed byte in the Graphic Control Extension block. + Disposal is three-bits with the following codes: + |0 0 0 [0 0 0] 0 0| + 1 => leave current frame and draw on top of it (#leaveCurrent) + 2 => Restore to background color (#restoreBackground) + 3 => Restore to state before current frame was drawn (#restorePrevState)" + | least middle both | + (both := (aPackedByte bitAnd: 12) = 12). + both ifTrue: [ ^ #restorePrevState ]. + + least := (aPackedByte bitAnd: 4) = 4. + least ifTrue: [ ^ #leaveCurrent ]. + + middle := (aPackedByte bitAnd: 8) = 8. + middle ifTrue: [ ^ #restoreBackground ]. + + ^ #otherDisposal + ! Item was added: + ----- Method: GIFReadWriter>>readExtensionBlock:withFrame: (in category 'private - decoding') ----- + readExtensionBlock: aGifBlock withFrame: anImageFrame + "Determine which type of extension block we are + looking at. The most common is the Graphic Control Extension (GCE) + which tells us information about the image frame, including delays + offsets in the canvas, and how to dispose of the frame in animation" + | extensionType packedByte delayByte1 delayByte2 | + extensionType := self next. + + "255 is an Application Extension. + This seems to always be the NETSCAPE + extension, which has looping information. + This extension does not affect individual frames, + but rather sets the loopCount for the whole image" + extensionType = 255 ifTrue: [ + ^ self readApplicationExtension ]. + + + "249 Corresponds to the GCE" + extensionType = 249 ifTrue: [ + self next = 4 ifFalse: [ ^ self "The GIF is likely corrupt in this case" ]. + "==== + Reserved 3 Bits (Ignore) + Disposal Method 3 Bits + User Input Flag 1 Bit (Ignore) + Transparent Color Flag 1 Bit (Need to Implement) + ===" + packedByte := self next. + delayByte1 := self next. + delayByte2 := self next. + transparentIndex := self next. + (packedByte bitAnd: 1) = 0 "Changed to see if other endian is the real end..." + ifTrue: [ transparentIndex := nil ]. + anImageFrame + disposal: (self readDisposal: packedByte); + "Delay time is stored as 2 bytes unsigned" + delay: (delayByte2 * 256 + delayByte1) * 10. + self next = 0 ifFalse: [ ^ self error: 'Corrupt GCE Block!!' ]. + ^ self ]. + + extensionType = 254 ifTrue: [ + ^ self readCommentExtension ]. + + "If you get to this point, we don't know the Extension Type" + ^ self error: 'Unknown GIF Extension: ',(extensionType asString).! Item was changed: + ----- Method: GIFReadWriter>>readHeader (in category 'private - decoding') ----- - ----- Method: GIFReadWriter>>readHeader (in category 'private-decoding') ----- readHeader | is89 byte hasColorMap | + (self hasMagicNumber: 'GIF87a' asByteArray) + ifTrue: [ is89 := false ] + ifFalse: + [ (self hasMagicNumber: 'GIF89a' asByteArray) + ifTrue: [ is89 := true ] + ifFalse: [ ^ self error: 'This does not appear to be a GIF file' ] ]. + "Width and Height for whole canvas, not + just an invididual frame/form" + canvasWidth := self readWord. + canvasHeight := self readWord. - (self hasMagicNumber: 'GIF87a' asByteArray) - ifTrue: [is89 := false] - ifFalse: [(self hasMagicNumber: 'GIF89a' asByteArray) - ifTrue: [is89 := true] - ifFalse: [^ self error: 'This does not appear to be a GIF file']]. - self readWord. "skip Screen Width" - self readWord. "skip Screen Height" byte := self next. + hasColorMap := (byte bitAnd: 128) ~= 0. - hasColorMap := (byte bitAnd: 16r80) ~= 0. bitsPerPixel := (byte bitAnd: 7) + 1. + backgroundColorIndex := self next. + self next ~= 0 ifTrue: + [ is89 ifFalse: [ ^ self error: 'corrupt GIF file (screen descriptor)' ] ]. + hasColorMap + ifTrue: [ colorPalette := self readColorTable: (1 bitShift: bitsPerPixel) ] + ifFalse: + [ colorPalette := nil "Palette monochromeDefault" ]! - byte := self next. "skip background color." - self next ~= 0 - ifTrue: [is89 - ifFalse: [^self error: 'corrupt GIF file (screen descriptor)']]. - hasColorMap - ifTrue: - [colorPalette := self readColorTable: (1 bitShift: bitsPerPixel)] - ifFalse: - ["Transcript cr; show: 'GIF file does not have a color map.'." - colorPalette := nil "Palette monochromeDefault"].! Item was changed: + ----- Method: GIFReadWriter>>readWord (in category 'private - decoding') ----- - ----- Method: GIFReadWriter>>readWord (in category 'private-decoding') ----- readWord ^self next + (self next bitShift: 8)! Item was removed: - ----- Method: GIFReadWriter>>setParameters: (in category 'private') ----- - setParameters: initCodeSize - clearCode := 1 bitShift: initCodeSize. - eoiCode := clearCode + 1. - freeCode := clearCode + 2. - codeSize := initCodeSize + 1. - maxCode := (1 bitShift: codeSize) - 1! Item was changed: ----- Method: GIFReadWriter>>setStream: (in category 'accessing') ----- + setStream: aStream - setStream: aStream "Feed it in from an existing source" stream := aStream! Item was removed: - ----- Method: GIFReadWriter>>skipBitData (in category 'private-decoding') ----- - skipBitData - | misc blocksize | - self readWord. "skip Image Left" - self readWord. "skip Image Top" - self readWord. "width" - self readWord. "height" - misc := self next. - (misc bitAnd: 16r80) = 0 ifFalse: [ "skip colormap" - 1 to: (1 bitShift: (misc bitAnd: 7) + 1) do: [:i | - self next; next; next]]. - self next. "minimum code size" - [(blocksize := self next) > 0] - whileTrue: [self next: blocksize]! Item was changed: ----- Method: GIFReadWriter>>understandsImageFormat (in category 'accessing') ----- understandsImageFormat ^('abc' collect: [:x | stream next asCharacter]) = 'GIF'! Item was changed: ----- Method: GIFReadWriter>>updatePixelPosition (in category 'private') ----- updatePixelPosition + (xpos := xpos + 1) >= width ifFalse: [ ^ self ]. - (xpos := xpos + 1) >= width ifFalse: [^self]. xpos := 0. + interlace ifFalse: + [ ypos := ypos + 1. + ^ self ]. + pass = 0 ifTrue: + [ (ypos := ypos + 8) >= height ifTrue: + [ pass := pass + 1. + ypos := 4 ]. + ^ self ]. + pass = 1 ifTrue: + [ (ypos := ypos + 8) >= height ifTrue: + [ pass := pass + 1. + ypos := 2 ]. + ^ self ]. + pass = 2 ifTrue: + [ (ypos := ypos + 4) >= height ifTrue: + [ pass := pass + 1. + ypos := 1 ]. + ^ self ]. + pass = 3 ifTrue: + [ ypos := ypos + 2. + ^ self ]. + ^ self error: 'can''t happen'! - interlace - ifFalse: [ypos := ypos + 1. ^self]. - pass = 0 ifTrue: - [(ypos := ypos + 8) >= height - ifTrue: - [pass := pass + 1. - ypos := 4]. - ^self]. - pass = 1 ifTrue: - [(ypos := ypos + 8) >= height - ifTrue: - [pass := pass + 1. - ypos := 2]. - ^self]. - pass = 2 ifTrue: - [(ypos := ypos + 4) >= height - ifTrue: - [pass := pass + 1. - ypos := 1]. - ^self]. - pass = 3 ifTrue: - [ypos := ypos + 2. - ^self]. - - ^self error: 'can''t happen'! Item was changed: + ----- Method: GIFReadWriter>>writeBitData: (in category 'private - encoding') ----- + writeBitData: bits - ----- Method: GIFReadWriter>>writeBitData: (in category 'private-encoding') ----- - writeBitData: bits "using modified Lempel-Ziv Welch algorithm." + | encoder initCodeSize | + encoder := LzwGifEncoder new + rowByteSize: (width * 8 + 31) // 32 * 4; + extent: width@height; + codeStream: stream. + initCodeSize := bitsPerPixel <= 1 + ifTrue: [ 2 ] + ifFalse: [ bitsPerPixel ]. + encoder minimumCodeSize: initCodeSize. + encoder encode: bits.! - - | maxBits maxMaxCode tSize initCodeSize ent tShift fCode pixel index disp nomatch | - pass := 0. - xpos := 0. - ypos := 0. - rowByteSize := width * 8 + 31 // 32 * 4. - remainBitCount := 0. - bufByte := 0. - bufStream := WriteStream on: (ByteArray new: 256). - - maxBits := 12. - maxMaxCode := 1 bitShift: maxBits. - tSize := 5003. - prefixTable := Array new: tSize. - suffixTable := Array new: tSize. - - initCodeSize := bitsPerPixel <= 1 ifTrue: [2] ifFalse: [bitsPerPixel]. - self nextPut: initCodeSize. - self setParameters: initCodeSize. - - tShift := 0. - fCode := tSize. - [fCode < 65536] whileTrue: - [tShift := tShift + 1. - fCode := fCode * 2]. - tShift := 8 - tShift. - 1 to: tSize do: [:i | suffixTable at: i put: -1]. - - self writeCodeAndCheckCodeSize: clearCode. - ent := self readPixelFrom: bits. - [(pixel := self readPixelFrom: bits) == nil] whileFalse: - [ - fCode := (pixel bitShift: maxBits) + ent. - index := ((pixel bitShift: tShift) bitXor: ent) + 1. - (suffixTable at: index) = fCode - ifTrue: [ent := prefixTable at: index] - ifFalse: - [nomatch := true. - (suffixTable at: index) >= 0 - ifTrue: - [disp := tSize - index + 1. - index = 1 ifTrue: [disp := 1]. - "probe" - [(index := index - disp) < 1 ifTrue: [index := index + tSize]. - (suffixTable at: index) = fCode - ifTrue: - [ent := prefixTable at: index. - nomatch := false. - "continue whileFalse:"]. - nomatch and: [(suffixTable at: index) > 0]] - whileTrue: ["probe"]]. - "nomatch" - nomatch ifTrue: - [self writeCodeAndCheckCodeSize: ent. - ent := pixel. - freeCode < maxMaxCode - ifTrue: - [prefixTable at: index put: freeCode. - suffixTable at: index put: fCode. - freeCode := freeCode + 1] - ifFalse: - [self writeCodeAndCheckCodeSize: clearCode. - 1 to: tSize do: [:i | suffixTable at: i put: -1]. - self setParameters: initCodeSize]]]]. - prefixTable := suffixTable := nil. - self writeCodeAndCheckCodeSize: ent. - self writeCodeAndCheckCodeSize: eoiCode. - self flushCode. - - self nextPut: 0. "zero-length packet" - ! Item was removed: - ----- Method: GIFReadWriter>>writeCode: (in category 'private-encoding') ----- - writeCode: aCode - self nextBitsPut: aCode! Item was removed: - ----- Method: GIFReadWriter>>writeCodeAndCheckCodeSize: (in category 'private-encoding') ----- - writeCodeAndCheckCodeSize: aCode - self writeCode: aCode. - self checkCodeSize! Item was added: + ----- Method: GIFReadWriter>>writeDisposal:toPackedByte: (in category 'writing') ----- + writeDisposal: aSymbol toPackedByte: aByte + "Using the GIF Graphics Control Extension + packed byte format, respond with a modified version + of the passed byte that includes the correct 3-bit + disposal code corresponding to the passed in symbol" + + aSymbol = #restoreBackground + ifTrue: [ + "This is a value of 2 in the 3-bit structure, + so 010, then shifted two to the left (equal to 8)" + ^ aByte + (2 bitShift: 2) ]. + + aSymbol = #leaveCurrent + ifTrue: [ + "This is a value of 1 in the 3-bit structure, + so 001, then shifted two to the left (equal to 4)" + ^ aByte + (1 bitShift: 2) ]. + + aSymbol = #restorePrevState + ifTrue: [ + "This is a value of 3 in the 3-bit structure, + so 011, then shifted two to the left (equal to 12)" + ^ aByte + (3 bitShift: 2) ]. + ^ aByte + ! Item was added: + ----- Method: GIFReadWriter>>writeFrameHeader: (in category 'accessing') ----- + writeFrameHeader: anImageFrame + "Write any Extensions and/or headers that apply + to individual frames/subimages" + | interlaceByte | + anImageFrame delay notNil | transparentIndex notNil ifTrue: [ + self writeGCEForFrame: anImageFrame ]. + + "Next is the image descriptor" + self + nextPut: ImageSeparator; + writeWord: (anImageFrame offset x); + writeWord: (anImageFrame offset y); + writeWord: (anImageFrame form extent x); + writeWord: (anImageFrame form extent y). + + interlaceByte := interlace + ifTrue: [ 64 ] + ifFalse: [ 0 ]. + self nextPut: interlaceByte + ! Item was added: + ----- Method: GIFReadWriter>>writeGCEForFrame: (in category 'private - encoding') ----- + writeGCEForFrame: anAnimatedImageFrame + "Writes a Graphics Control Extension onto + the output stream for the given image frame" + | nextDelay packedByte | + nextDelay := anAnimatedImageFrame delay. + anAnimatedImageFrame delay ifNil: [ nextDelay := 0 ]. + "Set the bits of the packed byte" + "==== + Reserved 3 Bits (Ignore) + Disposal Method 3 Bits + User Input Flag 1 Bit (Ignore) + Transparent Color Flag 1 Bit + ===" + packedByte := 0. + transparentIndex + ifNotNil: [ packedByte := 1 ]. + packedByte := self + writeDisposal: (anAnimatedImageFrame disposal) + toPackedByte: packedByte. + + self + nextPut: Extension; + nextPutAll: #(249 4) asByteArray; + nextPut: packedByte; + "nextPut: (transparentIndex + ifNil: [ 0 ] + ifNotNil: [ 9 ]);" + writeWord: nextDelay // 10; + nextPut: (transparentIndex ifNil: [ 0 ]); + nextPut: 0.! Item was changed: + ----- Method: GIFReadWriter>>writeHeader (in category 'private - encoding') ----- - ----- Method: GIFReadWriter>>writeHeader (in category 'private-encoding') ----- writeHeader - | byte | + "Write the overall image file header onto the + output stream. This includes the global information + about the file, such as canvasWidth etc. Only do so + if the stream is in the initial position." + stream position = 0 ifFalse: [ ^ self ]. - stream position = 0 ifTrue: [ - "For first image only" - self - nextPutAll: #[71 73 70 56 57 97]; "'GIF89a' asByteArray" - writeWord: width; "Screen Width" - writeWord: height. "Screen Height" - byte := 16r80. "has color map" - byte := byte bitOr: ((bitsPerPixel - 1) bitShift: 5). "color resolution" - byte := byte bitOr: bitsPerPixel - 1. "bits per pixel" - self - nextPut: byte; - nextPut: 0; "background color." - nextPut: 0. "reserved" - colorPalette do: [:pixelValue | - self nextPut: ((pixelValue bitShift: -16) bitAnd: 255); - nextPut: ((pixelValue bitShift: -8) bitAnd: 255); - nextPut: (pixelValue bitAnd: 255)]. - loopCount ifNotNil: [ - "Write a Netscape loop chunk" - self - nextPut: Extension; - nextPutAll: #[255 11 78 69 84 83 67 65 80 69 50 46 48 3 1]; - writeWord: loopCount; - nextPut: 0]]. + self nextPutAll: 'GIF89a' asByteArray. + self writeWord: width. "Screen Width" + self writeWord: height. "Screen Height" + byte := 128. "has color map" + byte := byte bitOr: (bitsPerPixel - 1 bitShift: 5). "color resolution" + byte := byte bitOr: bitsPerPixel - 1. "bits per pixel" - (delay notNil and: [ transparentIndex notNil ]) ifTrue: [ - self nextPut: Extension; - nextPutAll: #[16rF9 4]; - nextPut: (transparentIndex ifNil: [0] ifNotNil: [9]); - writeWord: (delay ifNil: [0] ifNotNil: [delay]); - nextPut: (transparentIndex ifNil: [0] ifNotNil: [transparentIndex]); - nextPut: 0]. - - self - nextPut: ImageSeparator; - writeWord: 0; "Image Left" - writeWord: 0; "Image Top" - writeWord: width; "Image Width" - writeWord: height. "Image Height" - byte := interlace ifTrue: [16r40] ifFalse: [0]. self nextPut: byte. + self nextPut: 0. "background color." + self nextPut: 0. "reserved / unused 'pixel aspect ratio" + colorPalette do: + [ :pixelValue | + self + nextPut: ((pixelValue bitShift: -16) bitAnd: 255); + nextPut: ((pixelValue bitShift: -8) bitAnd: 255); + nextPut: (pixelValue bitAnd: 255) ]. + loopCount notNil ifTrue: + [ self writeNetscapeExtension ].! - ! Item was added: + ----- Method: GIFReadWriter>>writeNetscapeExtension (in category 'private - encoding') ----- + writeNetscapeExtension + "Writes a GIF Application Extension corresponding + to the NETSCAPE2.0 version, with specifies the loopCount." + self + nextPut: Extension; + nextPut: 255; "Indicates Application Extension" + nextPut: 11; "Indicates how many bytes follow, almost always 11" + nextPutAll: ('NETSCAPE2.0' asByteArray); + nextPut: 3; + nextPut: 1; + writeWord: (loopCount ifNil: [ 0 ]); + nextPut: 0.! Item was changed: + ----- Method: GIFReadWriter>>writeWord: (in category 'private - encoding') ----- - ----- Method: GIFReadWriter>>writeWord: (in category 'private-encoding') ----- writeWord: aWord self nextPut: (aWord bitAnd: 255). self nextPut: ((aWord bitShift: -8) bitAnd: 255). ^aWord! Item was added: + Object subclass: #LzwGifDecoder + instanceVariableNames: 'suffixTable prefixTable eoiCode clearCode bitMask codeSize minimumCodeSize maxCode nextAvailableCode numLeftoverBits codeStream codeStreamBuffer outBlock' + classVariableNames: '' + poolDictionaries: '' + category: 'Graphics-Files'! + + !LzwGifDecoder commentStamp: '' prior: 0! + I implement the modified Lempel-Ziv-Welch (LZW) algorithm for lossless GIF decompression. My primary purpose is to decode streams of bytes that have been encoded with this modified version of LZW as used in the GIF standard. + + My instances require, at minimum, a maximum code size (via #maxCode:), a minimum code size (via #minimumCodeSize:), and of course a stream of bytes to decode (via #codeStream:). Once these are set, implementors can simply send the #decode message, which will respond with a decoded ByteArray. + + Optionally, implementors can make use of the #onDecodedBit: message, which takes a Block with a single argument corresponding to a decoded bit. This Block is called each time a complete byte/bit-level value for the bitmap has been decoded. + + For an example of use, see GIFReadWriter >> #readBitDataOnFrame:. + + I am separated out from GIFReadWriter for clarity and better debugging. + + + + See: + https://en.wikipedia.org/wiki/Lempel%E2%80%93Ziv%E2%80%93Welch + https://www.w3.org/Graphics/GIF/spec-gif89a.txt + + ! Item was added: + ----- Method: LzwGifDecoder>>bufferData (in category 'as yet unclassified') ----- + bufferData + "The GIF Format stores the data for each image in sub-blocks of up to 255 bytes. + Decoding LZW for such small chunks adds a LOT of overhead. + So instead, we buffer *all* of the data into one ByteArray and provide stream access + to it. + Data sub-blocks are structured such that the first byte gives the size of the data chunk + that follows. A size of 0 indicates that there is no more data to deal with" + | chunkSize buff | + buff := WriteStream on: ByteArray new. + chunkSize := codeStream next. + [ chunkSize > 0 ] whileTrue: [ + buff nextPutAll: (codeStream next: chunkSize). + chunkSize := codeStream next ]. + "chunkSize > 0 ifTrue: [ buff nextPutAll: (codeStream next: chunkSize)]." + codeStreamBuffer := buff contents readStream! Item was added: + ----- Method: LzwGifDecoder>>checkCodeSize (in category 'private') ----- + checkCodeSize + "Ensure that the next available code to enter + into the table is not equal to the bitMask. + If it is, we increment the code size and update the + mask value." + nextAvailableCode := nextAvailableCode + 1. + (nextAvailableCode bitAnd: bitMask) = 0 + ifTrue: [ + "GIF89a specifies a 'deferred' clearCode + implementation, which means we keep going + with the current table even if its full but + a clear hasn't been found. We use the max + code size at that point." + nextAvailableCode >= maxCode ifTrue: [ ^ self ]. + codeSize := codeSize + 1. + bitMask := bitMask + nextAvailableCode ].! Item was added: + ----- Method: LzwGifDecoder>>codeStream: (in category 'private') ----- + codeStream: aReadableStream + "Set the stream of encoded bytes we will decode + to be the internal codeStream. We read off the first + byte immediately, which tells us how many subsequent bytes + to use in our buffer for decoding" + | chunkSize buff | + codeStream := aReadableStream. + "chunkSize := codeStream next. + codeStreamBuffer := ReadStream on: (codeStream next: chunkSize)." + self bufferData + ! Item was added: + ----- Method: LzwGifDecoder>>decode (in category 'api') ----- + decode + | currentCode prevCode outStream | + self initializeTables. + outStream := WriteStream with: (ByteArray new). + numLeftoverBits := 0. + currentCode := self nextCode. + currentCode = clearCode ifFalse: [ ^ self error: 'First code on the stream should always be the clear code!!' ]. + + "The first real code simply gets output + onto the stream, then we enter the loop" + currentCode := self nextCode. + self writeBit: currentCode on: outStream. + prevCode := currentCode. + currentCode := self nextCode. + [ currentCode = eoiCode ] whileFalse: [ + currentCode = clearCode + ifTrue: [ + self initializeTables. + currentCode := self nextCode. + self + writeBit: (suffixTable at: (currentCode + 1)) + on: outStream. + prevCode := nil ] + ifFalse: [ self handleCode: currentCode withPreviousCode: prevCode on: outStream ]. + prevCode := currentCode. + currentCode := self nextCode ]. + ^ outStream contents. + + + ! Item was added: + ----- Method: LzwGifDecoder>>handleCode:withPreviousCode:on: (in category 'private') ----- + handleCode: anInteger withPreviousCode: prevInteger on: aWriteStream + "Check for the code in the tables + and perform the appropriate LZW action" + | first searchIndex searchStack | + "The code already exists in the table" + anInteger < nextAvailableCode + ifTrue: [ + anInteger < clearCode + "If it's less than the clearCode + then it is one of the original entries + and we can simply use the suffix" + ifTrue: [ + first := (suffixTable at: (anInteger + 1)). + self writeBit: first on: aWriteStream ] + "Otherwise we need to loop backwards along + the prefix index values and take the suffix each + time" + ifFalse: [ + searchStack := OrderedCollection new. + searchIndex := anInteger + 1. + [ searchIndex > clearCode ] whileTrue: [ + searchStack add: (suffixTable at: searchIndex). + searchIndex := (prefixTable at: searchIndex) + 1 ]. + searchStack add: (suffixTable at: searchIndex). + first := searchStack last. + searchStack reverseDo: [ :int | + self writeBit: int on: aWriteStream ] ]. + ] + ifFalse: [ + "Here, the incoming code is not yet in the code tables" + prevInteger < clearCode + ifTrue: [ + first := (suffixTable at: (prevInteger + 1)). + self + writeBit: first on: aWriteStream; + writeBit: first on: aWriteStream. + ] + ifFalse: [ + searchStack := OrderedCollection new. + searchIndex := prevInteger + 1. + [ searchIndex > clearCode ] whileTrue: [ + searchStack add: (suffixTable at: searchIndex). + searchIndex := (prefixTable at: searchIndex) + 1 ]. + searchStack add: (suffixTable at: searchIndex). + first := searchStack last. + searchStack reverseDo: [ :int | + self writeBit: int on: aWriteStream ]. + self writeBit: first on: aWriteStream ]. + ]. + "We add prevCode and the new + suffix to a new entry in the code table, but + only if we aren't at the max. NOTE: due to + GIF 89a spec's 'deferred clear', if you get to + the maxCode and haven't seen a clear, you stop + writing to the tables but continue querying." + nextAvailableCode >= maxCode + ifFalse: [ + suffixTable at: (nextAvailableCode + 1) put: first. + prefixTable at: (nextAvailableCode + 1) put: prevInteger ]. + self checkCodeSize.! Item was added: + ----- Method: LzwGifDecoder>>initializeTables (in category 'initialization') ----- + initializeTables + "The two arrays are our lookup tables. + We do this instead of Dictionaries because + the method is much, much faster" + prefixTable := Array new: (maxCode). + suffixTable := Array new: (maxCode). + + "The initial code size and mask settings + also get reinitialized each time" + codeSize := minimumCodeSize + 1. + clearCode := (1 bitShift: minimumCodeSize). + eoiCode := clearCode + 1. + nextAvailableCode := clearCode + 2. + bitMask := (1 bitShift: codeSize) - 1. + + "Fill the tables with the initial values" + 1 to: clearCode do: [ :n | + prefixTable at: n put: (n - 1). + suffixTable at: n put: (n - 1) ].! Item was added: + ----- Method: LzwGifDecoder>>maxCode: (in category 'accessing') ----- + maxCode: anInteger + maxCode := anInteger! Item was added: + ----- Method: LzwGifDecoder>>minimumCodeSize: (in category 'accessing') ----- + minimumCodeSize: anInteger + minimumCodeSize := anInteger! Item was added: + ----- Method: LzwGifDecoder>>nextByte (in category 'private - packing') ----- + nextByte + ^ codeStreamBuffer next! Item was added: + ----- Method: LzwGifDecoder>>nextCode (in category 'private') ----- + nextCode + | integer numBitsRead newRemainder shiftAmount byte | + "Retrieve the next code of codeSize bits. + Store the remaining bits etc for later computation" + integer := 0. + numLeftoverBits = 0 + ifTrue: [ + numBitsRead := 8. + shiftAmount := 0 ] + ifFalse: [ + numBitsRead := numLeftoverBits. + shiftAmount := numLeftoverBits - 8 ]. + [ numBitsRead < codeSize ] whileTrue: [ + byte := self nextByte. + byte == nil ifTrue: [ ^ eoiCode ]. + integer := integer + (byte bitShift: shiftAmount). + shiftAmount := shiftAmount + 8. + numBitsRead := numBitsRead + 8 ]. + (newRemainder := numBitsRead - codeSize) = 0 + ifTrue: [ byte := self nextByte ] + ifFalse: [ byte := self peekByte ]. + byte == nil ifTrue: [ ^ eoiCode ]. + numLeftoverBits := newRemainder. + ^ integer + (byte bitShift: shiftAmount) bitAnd: bitMask.! Item was added: + ----- Method: LzwGifDecoder>>onDecodedBit: (in category 'accessing') ----- + onDecodedBit: aBlock + "This block will be executed once each time a new + value is decoded from the stream, with the value + as the sole argument passed to the block" + outBlock := aBlock! Item was added: + ----- Method: LzwGifDecoder>>peekByte (in category 'private - packing') ----- + peekByte + ^ codeStreamBuffer peek! Item was added: + ----- Method: LzwGifDecoder>>writeBit:on: (in category 'writing') ----- + writeBit: anInteger on: aWriteStream + "Write the incoming decoded value onto a + writestream. If I have an outBlock set, + send this value also" + aWriteStream nextPut: anInteger. + outBlock ifNil: [ ^ self ]. + outBlock value: anInteger.! Item was added: + Object subclass: #LzwGifEncoder + instanceVariableNames: 'suffixTable prefixTable eoiCode clearCode codeSize minimumCodeSize maxCode nextAvailableCode numLeftoverBits bitBuffer codeStream codeStreamBuffer rowByteSize xPos yPos dimensions' + classVariableNames: '' + poolDictionaries: '' + category: 'Graphics-Files'! + + !LzwGifEncoder commentStamp: '' prior: 0! + I implement the modified Lempel-Ziv-Welch (LZW) algorithm for lossless GIF bitmap compression. My primary purpose is to encode/compress streams of bitmap bytes as specified by the GIF standard. + + My instances require at minimum: + - A size of bytes in a row of bitmap bits for the image (#rowByteSize:) + - The extent of the image being encoded (#extent:) + - An array of bits in a bitmap (as bytes) for encoding (sent with #encode:) + - A stream of Bytes on which to output the encoded bytes (#codeStream:) + - A minimum code size as specified from GIF header information (#minimimCodeSize:) + + Once all of these are set, implementors simply send the #encode: message along with a + collection of bitmap values as bytes that need to be encoded. Instead of responding with a collection of encoded bytes, #encode: will write to the output stream specified by #codeStream: directly. + + For an example of use, see GIFReadWriter >> #writeBitData: + + NOTE: LZW compression for GIFs is complex and the #encode: method is largely taken verbatim from Kazuki Yasumatsu's 1995 Squeak implementation (as opposed to the Decoder, which was heavily refactored for readability and comprehension). Any contributions to fleshing this out in a comprehensible way are much appreciated!! + + See: + https://en.wikipedia.org/wiki/Lempel%E2%80%93Ziv%E2%80%93Welch + https://www.w3.org/Graphics/GIF/spec-gif89a.txt! Item was added: + ----- Method: LzwGifEncoder>>checkCodeSize (in category 'private') ----- + checkCodeSize + "Determine whether or not we need to increment + the codeSize" + (nextAvailableCode > maxCode and: [ codeSize < 12 ]) + ifTrue: [ + codeSize := codeSize + 1. + maxCode := (1 bitShift: codeSize) - 1 ].! Item was added: + ----- Method: LzwGifEncoder>>checkSettings (in category 'private') ----- + checkSettings + "Ensure that the appropriate variables + that are needed for proper encoding + have been set" + codeStream ifNil: [ ^ self error: 'You must set a codeStream (byte stream) to write onto!!' ]. + dimensions ifNil: [ ^ self error: 'You must provide the extent of the image we will encode!!' ]. + rowByteSize ifNil: [ ^ self error: 'You must provide a rowByteSize for the supplied image bits!!' ].! Item was added: + ----- Method: LzwGifEncoder>>codeStream: (in category 'accessing') ----- + codeStream: aByteStream + codeStream := aByteStream.! Item was added: + ----- Method: LzwGifEncoder>>dimensions: (in category 'accessing') ----- + dimensions: anExtentPoint + "Set the extent (as point) of the + image that will be encoded" + dimensions := anExtentPoint! Item was added: + ----- Method: LzwGifEncoder>>encode: (in category 'converting') ----- + encode: bits + | maxBits maxMaxCode tSize tShift fCode ent pixel index nomatch disp | + self checkSettings. + xPos := yPos := 0. + codeStream nextPut: minimumCodeSize. + bitBuffer := 0. + numLeftoverBits := 0. + codeStreamBuffer := WriteStream on: (ByteArray new: 256). + self initializeParameters. + + "These temp vars are taken from the + original GIFReadWriter implementation" + maxBits := 12. + maxMaxCode := 1 bitShift: maxBits. + tSize := 5003. + prefixTable := Array new: tSize. + suffixTable := Array new: tSize. + tShift := 0. + fCode := tSize. + [ fCode < 65536 ] whileTrue: [ + tShift := tShift + 1. + fCode := fCode * 2 ]. + tShift := 8 - tShift. + 1 to: tSize do: [ :i | + suffixTable at: i put: -1 ]. + + "We immediately write the clearCode + to the output stream" + self writeCodeAndCheckCodeSize: clearCode. + + "This loop is also taken from the original + GIFReadWriter implementation" + ent := self readPixelFrom: bits. + [ (pixel := self readPixelFrom: bits) == nil ] whileFalse: + [ fCode := (pixel bitShift: maxBits) + ent. + index := ((pixel bitShift: tShift) bitXor: ent) + 1. + (suffixTable at: index) = fCode + ifTrue: [ ent := prefixTable at: index ] + ifFalse: + [ nomatch := true. + (suffixTable at: index) >= 0 ifTrue: + [ disp := tSize - index + 1. + index = 1 ifTrue: [ disp := 1 ]. + "probe" + + [ (index := index - disp) < 1 ifTrue: [ index := index + tSize ]. + (suffixTable at: index) = fCode ifTrue: + [ ent := prefixTable at: index. + nomatch := false + "continue whileFalse:" ]. + nomatch and: [ (suffixTable at: index) > 0 ] ] whileTrue: + [ "probe" + ] ]. + "nomatch" + nomatch ifTrue: + [ self writeCodeAndCheckCodeSize: ent. + ent := pixel. + nextAvailableCode < maxMaxCode + ifTrue: + [ prefixTable + at: index + put: nextAvailableCode. + suffixTable + at: index + put: fCode. + nextAvailableCode := nextAvailableCode + 1 ] + ifFalse: + [ self writeCodeAndCheckCodeSize: clearCode. + 1 + to: tSize + do: + [ :i | + suffixTable + at: i + put: -1 ]. + self initializeParameters ] ] ] ]. + prefixTable := suffixTable := nil. + self writeCodeAndCheckCodeSize: ent. + self writeCodeAndCheckCodeSize: eoiCode. + self flushBits. + codeStream nextPut: 0. + ! Item was added: + ----- Method: LzwGifEncoder>>extent: (in category 'accessing') ----- + extent: anExtentPoint + "Set the extent (as point) of the + image that will be encoded" + dimensions := anExtentPoint! Item was added: + ----- Method: LzwGifEncoder>>flushBits (in category 'private - bits access') ----- + flushBits + numLeftoverBits = 0 ifFalse: + [ self nextBytePut: bitBuffer. + numLeftoverBits := 0 ]. + self flushBuffer! Item was added: + ----- Method: LzwGifEncoder>>flushBuffer (in category 'private') ----- + flushBuffer + "Write out the current codeStreamBuffer size, + followed by its actual contents, to the true + output codeStream" + codeStreamBuffer isEmpty ifTrue: [ ^ self ]. + codeStream + nextPut: codeStreamBuffer size; + nextPutAll: codeStreamBuffer contents. + codeStreamBuffer := (ByteArray new: 256) writeStream.! Item was added: + ----- Method: LzwGifEncoder>>initializeParameters (in category 'initialization') ----- + initializeParameters + "The initial code size and mask settings + also get reinitialized each time" + codeSize := minimumCodeSize + 1. + clearCode := (1 bitShift: minimumCodeSize). + eoiCode := clearCode + 1. + nextAvailableCode := clearCode + 2. + maxCode := (1 bitShift: codeSize) - 1.! Item was added: + ----- Method: LzwGifEncoder>>minimumCodeSize: (in category 'accessing') ----- + minimumCodeSize: anInteger + minimumCodeSize := anInteger! Item was added: + ----- Method: LzwGifEncoder>>nextBytePut: (in category 'private - packing') ----- + nextBytePut: anInteger + "Write a complete byte to the output byteStream. + Be sure to reset one we reach the limit, which is + 255 for GIF files. Then write the length of the next + byte chunks to the stream also" + codeStreamBuffer nextPut: anInteger. + codeStreamBuffer size >= 254 + ifTrue: [ self flushBuffer ].! Item was added: + ----- Method: LzwGifEncoder>>nextCodePut: (in category 'private - bits access') ----- + nextCodePut: anInteger + "Attempt to put the bits on the + output stream. If we have remaining bits, + then we need to use bitwise operations to + fill the next byte properly before putting + it on the output stream" + | numBitsWritten shiftCount newInteger | + shiftCount := 0. + numLeftoverBits = 0 + ifTrue: [ + numBitsWritten := 8. + newInteger := anInteger ] + ifFalse: [ + numBitsWritten := numLeftoverBits. + newInteger := bitBuffer + (anInteger bitShift: 8 - numLeftoverBits) ]. + [ numBitsWritten < codeSize ] whileTrue: [ + self nextBytePut: ((newInteger bitShift: shiftCount) bitAnd: 255). + shiftCount := shiftCount - 8. + numBitsWritten := numBitsWritten + 8 ]. + (numLeftoverBits := numBitsWritten - codeSize) = 0 + ifTrue: [ self nextBytePut: (newInteger bitShift: shiftCount) ] + ifFalse: [ bitBuffer := newInteger bitShift: shiftCount ]. + ^ anInteger + ! Item was added: + ----- Method: LzwGifEncoder>>readPixelFrom: (in category 'private - encoding') ----- + readPixelFrom: bits + "Using the current x and y positions and + the specified byte size for a row, determine + the value for the next pixel in the provided bits" + | pixel | + yPos >= (dimensions y) ifTrue: [ ^ nil ]. + pixel := bits byteAt: yPos * rowByteSize + xPos + 1. + self updatePixelPosition. + ^ pixel + ! Item was added: + ----- Method: LzwGifEncoder>>rowByteSize: (in category 'accessing') ----- + rowByteSize: anInteger + rowByteSize := anInteger! Item was added: + ----- Method: LzwGifEncoder>>updatePixelPosition (in category 'private') ----- + updatePixelPosition + "Increment the xPos. If we are at the width + position, set xPos to 0 and increment the yPos" + xPos := xPos + 1. + xPos >= (dimensions x) ifFalse: [ ^ self ]. + xPos := 0. + yPos := yPos + 1.! Item was added: + ----- Method: LzwGifEncoder>>writeCodeAndCheckCodeSize: (in category 'writing') ----- + writeCodeAndCheckCodeSize: aCode + self nextCodePut: aCode. + self checkCodeSize.! Item was changed: ----- Method: Point>>\\ (in category 'arithmetic') ----- \\ arg "Answer a Point that is the mod of the receiver and arg." arg isPoint ifTrue: [^ (x \\ arg x) @ (y \\ arg y)]. ^ arg adaptToPoint: self andSend: #\\! Item was changed: + (PackageInfo named: 'Graphics') postscript: 'Smalltalk removeFromStartUpList: DisplayScreen. "see Project class >> #startUp" - (PackageInfo named: 'Graphics') postscript: 'Smalltalk removeFromStartUpList: DisplayScreen. "see Project class >> #startUp" Smalltalk removeFromShutDownList: DisplayScreen. "see Project class >> #shutDown"'!

1 0

The Trunk: MorphicExtras-mt.314.mcz
by commits＠source.squeak.org 04 May '22

04 May '22

Marcel Taeumel uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-mt.314.mcz ==================== Summary ==================== Name: MorphicExtras-mt.314 Author: mt Time: 4 May 2022, 12:07:19.435048 pm UUID: 21980273-a7ba-0749-b4a9-e7b5c65b79d2 Ancestors: MorphicExtras-tpr.313 Complements Morphic-mt.1982. =============== Diff against MorphicExtras-tpr.313 =============== Item was removed: - ImageMorph subclass: #AnimatedImageMorph - instanceVariableNames: 'images delays stepTime nextTime imageIndex' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-AdditionalMorphs'! - - !AnimatedImageMorph commentStamp: '<historical>' prior: 0! - I am an ImageMorph that can hold more than one image. Each image has its own delay time.! Item was removed: - ----- Method: AnimatedImageMorph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') ----- - fileReaderServicesForFile: fullName suffix: suffix - - ^((AnimatedGIFReadWriter typicalFileExtensions asSet - add: '*'; add: 'form'; yourself) - includes: suffix) - ifTrue: [ self services ] - ifFalse: [#()] - ! Item was removed: - ----- Method: AnimatedImageMorph class>>fromGIFFileNamed: (in category 'instance creation') ----- - fromGIFFileNamed: fileName - | reader | - reader := AnimatedGIFReadWriter formsFromFileNamed: fileName. - ^reader forms size = 1 - ifTrue: [ ImageMorph new image: reader forms first ] - ifFalse: [ self new fromReader: reader ]! Item was removed: - ----- Method: AnimatedImageMorph class>>fromStream: (in category 'instance creation') ----- - fromStream: aStream - | reader | - reader := AnimatedGIFReadWriter formsFromStream: aStream. - ^reader forms size = 1 - ifTrue: [ ImageMorph new image: reader forms first ] - ifFalse: [ self new fromReader: reader ]! Item was removed: - ----- Method: AnimatedImageMorph class>>initialize (in category 'class initialization') ----- - initialize - "register the receiver in the global registries" - self environment - at: #FileServices - ifPresent: [:cl | cl registerFileReader: self]! Item was removed: - ----- Method: AnimatedImageMorph class>>openGIFInWindow: (in category 'instance creation') ----- - openGIFInWindow: aStream - ^(self fromStream: aStream binary) openInWorld! Item was removed: - ----- Method: AnimatedImageMorph class>>serviceOpenGIFInWindow (in category 'fileIn/Out') ----- - serviceOpenGIFInWindow - "Answer a service for opening a gif graphic in a window" - ^ (SimpleServiceEntry - provider: self - label: 'open the graphic as a morph' - selector: #openGIFInWindow: - description: 'open a GIF graphic file as a morph' - buttonLabel: 'open') - argumentGetter: [:fileList | fileList readOnlyStream]! Item was removed: - ----- Method: AnimatedImageMorph class>>services (in category 'fileIn/Out') ----- - services - ^ Array - with: self serviceOpenGIFInWindow - "with: Form serviceImageImports" - with: Form serviceImageAsBackground! Item was removed: - ----- Method: AnimatedImageMorph class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - self environment - at: #FileServices - ifPresent: [:cl | cl unregisterFileReader: self]! Item was removed: - ----- Method: AnimatedImageMorph>>delays (in category 'accessing') ----- - delays - - ^ delays! Item was removed: - ----- Method: AnimatedImageMorph>>fromGIFFileNamed: (in category 'private') ----- - fromGIFFileNamed: fileName - self fromReader: (AnimatedGIFReadWriter formsFromFileNamed: fileName)! Item was removed: - ----- Method: AnimatedImageMorph>>fromImages: (in category 'private') ----- - fromImages: anArray - - images := anArray. - self setUniformDelay: 10. - self isOpaque: true. - self reset.! Item was removed: - ----- Method: AnimatedImageMorph>>fromImages:delay: (in category 'private') ----- - fromImages: anArray delay: anInteger - - images := anArray. - self setUniformDelay: anInteger. - self isOpaque: true. - self reset.! Item was removed: - ----- Method: AnimatedImageMorph>>fromReader: (in category 'private') ----- - fromReader: reader - images := reader forms. - delays := reader delays. - (images anySatisfy:[:each|(each colors includes: Color transparent)]) ifTrue:[self isOpaque: true]. - self reset.! Item was removed: - ----- Method: AnimatedImageMorph>>fromStream: (in category 'private') ----- - fromStream: aStream - self fromReader: (AnimatedGIFReadWriter formsFromStream: aStream)! Item was removed: - ----- Method: AnimatedImageMorph>>images (in category 'accessing') ----- - images - ^images! Item was removed: - ----- Method: AnimatedImageMorph>>initialize (in category 'private') ----- - initialize - nextTime := Time millisecondClockValue. - imageIndex := 1. - stepTime := 10. - super initialize! Item was removed: - ----- Method: AnimatedImageMorph>>reset (in category 'private') ----- - reset - - imageIndex := 0. - self image: (Form extent: images first extent depth: 32). - self step.! Item was removed: - ----- Method: AnimatedImageMorph>>setUniformDelay: (in category 'private') ----- - setUniformDelay: anInteger - "set delay to a uniform value for all images" - delays := Array new: images size withAll: anInteger.! Item was removed: - ----- Method: AnimatedImageMorph>>step (in category 'stepping and presenter') ----- - step - | d form | - images isEmpty ifTrue: [^ self]. - - nextTime > Time millisecondClockValue - ifTrue: [^self]. - " self changed." - imageIndex > 0 ifTrue: [ - form := images at: imageIndex. - form displayOn: self image at: 0@0 rule: (self isOpaque ifTrue: [Form paint] ifFalse: [Form erase])]. - form := images at: (imageIndex := imageIndex \\ images size + 1). - form displayOn: self image at: 0@0 rule: Form paint. - self changed. - d := (delays at: imageIndex) ifNil: [0]. - nextTime := Time millisecondClockValue + d - ! Item was removed: - ----- Method: AnimatedImageMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - ^stepTime ifNil: [super stepTime]! Item was removed: - ----- Method: AnimatedImageMorph>>stepTime: (in category 'stepping and presenter') ----- - stepTime: anInteger - stepTime := anInteger! Item was removed: - ----- Method: AnimatedImageMorph>>wantsSteps (in category 'stepping and presenter') ----- - wantsSteps - ^(images size > 1) - !

1 0

The Trunk: Morphic-mt.1982.mcz
by commits＠source.squeak.org 04 May '22

04 May '22

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1982.mcz ==================== Summary ==================== Name: Morphic-mt.1982 Author: mt Time: 4 May 2022, 12:04:46.506048 pm UUID: b88fe7b3-4def-de40-8224-2d818301c24d Ancestors: Morphic-mt.1981, Morphic-EG.1829 Merges Morphic-EG.1829. Complements Graphics-mt.515. This commit represents an overhaul of AnimatedImageMorph, which is now designed to work with the new GIFReadWriter implementaiton. Image forms are composited ahead of time to improve performance and achieve better real world framerates. *** NOTE THAT we still need to do something about the loading performance. #composedFormsFromReader: is always computing full frames, no diffs. This is not good for the memory load and has no practical benefits compared with a single back-buffer that is updated per frame. Especially larger GIFs with diffs will suffer from huge loading times. =============== Diff against Morphic-mt.1981 =============== Item was added: + ImageMorph subclass: #AnimatedImageMorph + instanceVariableNames: 'images delays stepTime imageIndex' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Basic'! + + !AnimatedImageMorph commentStamp: 'EG 12/4/2021 12:33' prior: 0! + I am an ImageMorph that can hold more than one image. Each image has its own delay time. I am most commonly created using GIFReaderWriter when it contains multiple images/frames.! Item was added: + ----- Method: AnimatedImageMorph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') ----- + fileReaderServicesForFile: fullName suffix: suffix + + ^((GIFReadWriter typicalFileExtensions asSet + add: '*'; add: 'form'; yourself) + includes: suffix) + ifTrue: [ self services ] + ifFalse: [#()] + ! Item was added: + ----- Method: AnimatedImageMorph class>>fromGIFFileNamed: (in category 'instance creation') ----- + fromGIFFileNamed: fileName + | reader | + reader := GIFReadWriter formsFromFileNamed: fileName. + ^reader forms size = 1 + ifTrue: [ ImageMorph new image: reader forms first ] + ifFalse: [ self new fromGIFReader: reader ]! Item was added: + ----- Method: AnimatedImageMorph class>>fromStream: (in category 'instance creation') ----- + fromStream: aStream + | reader | + reader := GIFReadWriter formsFromStream: aStream. + ^reader forms size = 1 + ifTrue: [ ImageMorph new image: reader forms first ] + ifFalse: [ self new fromGIFReader: reader ]! Item was added: + ----- Method: AnimatedImageMorph class>>initialize (in category 'class initialization') ----- + initialize + "register the receiver in the global registries" + self environment + at: #FileServices + ifPresent: [:cl | cl registerFileReader: self]! Item was added: + ----- Method: AnimatedImageMorph class>>openGIFInWindow: (in category 'instance creation') ----- + openGIFInWindow: aStream + ^(self fromStream: aStream binary) openInWorld! Item was added: + ----- Method: AnimatedImageMorph class>>serviceOpenGIFInWindow (in category 'fileIn/Out') ----- + serviceOpenGIFInWindow + "Answer a service for opening a gif graphic in a window" + ^ (SimpleServiceEntry + provider: self + label: 'open the graphic as a morph' + selector: #openGIFInWindow: + description: 'open a GIF graphic file as a morph' + buttonLabel: 'open') + argumentGetter: [:fileList | fileList readOnlyStream]! Item was added: + ----- Method: AnimatedImageMorph class>>services (in category 'fileIn/Out') ----- + services + ^ Array + with: self serviceOpenGIFInWindow + "with: Form serviceImageImports" + with: Form serviceImageAsBackground! Item was added: + ----- Method: AnimatedImageMorph class>>unload (in category 'class initialization') ----- + unload + "Unload the receiver from global registries" + self environment + at: #FileServices + ifPresent: [:cl | cl unregisterFileReader: self]! Item was added: + ----- Method: AnimatedImageMorph>>addCustomMenuItems:hand: (in category 'stepping and presenter') ----- + addCustomMenuItems: aMenu hand: aHand + super addCustomMenuItems: aMenu hand: aHand. + aMenu addUpdating: #steppingString action: #toggleStepping! Item was added: + ----- Method: AnimatedImageMorph>>composedFormsFromReader: (in category 'frame composition') ----- + composedFormsFromReader: aGIFReader + "Compose a collection of Forms that are composited + from the incoming collection of Frames. We do this instead of + compositing each Form on the fly for performance reasons. + With this method, we can achieve better framerates for + Animated GIFs." + | nextForm compForm | + nextForm := Form extent: (aGIFReader canvasWidth)@(aGIFReader canvasHeight) depth: 32. + ^ aGIFReader frames collect: [ :frame | + frame form displayOn: nextForm at: 0@0 rule: Form paint. + compForm := nextForm. + frame disposal = #leaveCurrent + ifTrue: [ nextForm := nextForm copy ] + ifFalse: [ frame disposal = #restoreBackground + ifTrue: [ nextForm := Form extent: (aGIFReader canvasWidth)@(aGIFReader canvasHeight) depth: 32 ]]. + compForm ]! Item was added: + ----- Method: AnimatedImageMorph>>delays (in category 'accessing') ----- + delays + + ^ delays! Item was added: + ----- Method: AnimatedImageMorph>>fromGIFFileNamed: (in category 'private') ----- + fromGIFFileNamed: fileName + self fromReader: (GIFReadWriter formsFromFileNamed: fileName)! Item was added: + ----- Method: AnimatedImageMorph>>fromGIFReader: (in category 'initialization') ----- + fromGIFReader: aGIFReader + delays := aGIFReader delays. + self + stepTime: aGIFReader delays first; + images: (self composedFormsFromReader: aGIFReader); + yourself! Item was added: + ----- Method: AnimatedImageMorph>>fromImages: (in category 'private') ----- + fromImages: anArray + images := anArray. + self setUniformDelay: 10. + imageIndex := 0 + ! Item was added: + ----- Method: AnimatedImageMorph>>fromImages:delay: (in category 'private') ----- + fromImages: anArray delay: anInteger + images := anArray. + self setUniformDelay: anInteger.! Item was added: + ----- Method: AnimatedImageMorph>>fromReader: (in category 'private') ----- + fromReader: reader + images := reader forms. + delays := reader delays. + (images anySatisfy:[:each|(each colors includes: Color transparent)]) ifTrue:[self isOpaque: true]. + self reset.! Item was added: + ----- Method: AnimatedImageMorph>>fromStream: (in category 'private') ----- + fromStream: aStream + self fromGIFReader: (GIFReadWriter formsFromStream: aStream)! Item was added: + ----- Method: AnimatedImageMorph>>fromUrl: (in category 'initialization') ----- + fromUrl: aUrl + | request | + request := WebClient httpDo: [ :client | client httpGet: aUrl ]. + (request code = 200) not ifTrue: [ Error signal: 'Bad URL or Request' ]. + ((request headerAt: 'Content-Type') = 'image/gif') not + ifTrue: [ Error signal: 'Url does not respond with a gif, but a ', (request headerAt: 'Content-Type')]. + ^ self fromStream: request content asByteArray readStream.! Item was added: + ----- Method: AnimatedImageMorph>>images (in category 'private') ----- + images + ^images! Item was added: + ----- Method: AnimatedImageMorph>>images: (in category 'accessing') ----- + images: aCollectionOfForms + images := aCollectionOfForms! Item was added: + ----- Method: AnimatedImageMorph>>initialize (in category 'private') ----- + initialize + imageIndex := 1. + stepTime := 10. + super initialize! Item was added: + ----- Method: AnimatedImageMorph>>reset (in category 'private') ----- + reset + imageIndex := 1. + self image: (Form extent: self maxImagesExtent depth: 32).! Item was added: + ----- Method: AnimatedImageMorph>>setStepping: (in category 'stepping and presenter') ----- + setStepping: aBoolean + self wantsSteps ifFalse:[^false]. + aBoolean ifTrue:[self startStepping] + ifFalse:[self stopStepping].! Item was added: + ----- Method: AnimatedImageMorph>>setUniformDelay: (in category 'private') ----- + setUniformDelay: anInteger + "set delay to a uniform value for all images" + delays := Array new: images size withAll: anInteger.! Item was added: + ----- Method: AnimatedImageMorph>>step (in category 'stepping and presenter') ----- + step + ((imageIndex + 1) >= images size) + ifTrue: [ imageIndex := 1 ] + ifFalse: [ imageIndex := imageIndex + 1 ]. + self + stepTime: (delays at: imageIndex); + image: (images at: imageIndex) + ! Item was added: + ----- Method: AnimatedImageMorph>>stepTime (in category 'stepping and presenter') ----- + stepTime + ^stepTime ifNil: [super stepTime]! Item was added: + ----- Method: AnimatedImageMorph>>stepTime: (in category 'stepping and presenter') ----- + stepTime: anInteger + stepTime := anInteger! Item was added: + ----- Method: AnimatedImageMorph>>steppingString (in category 'stepping and presenter') ----- + steppingString + ^ (self isStepping + ifTrue: ['<on>'] + ifFalse: ['<off>']), 'stepping' translated! Item was added: + ----- Method: AnimatedImageMorph>>toggleStepping (in category 'stepping and presenter') ----- + toggleStepping + self wantsSteps + ifTrue: [ + self isStepping + ifFalse: [self startStepping] + ifTrue: [self stopStepping]]! Item was added: + ----- Method: AnimatedImageMorph>>wantsSteps (in category 'stepping and presenter') ----- + wantsSteps + ^(images size > 1) + !

1 0

The Trunk: GraphicsTests-mt.59.mcz
by commits＠source.squeak.org 04 May '22

04 May '22

Marcel Taeumel uploaded a new version of GraphicsTests to project The Trunk: http://source.squeak.org/trunk/GraphicsTests-mt.59.mcz ==================== Summary ==================== Name: GraphicsTests-mt.59 Author: mt Time: 4 May 2022, 12:00:53.679048 pm UUID: 8e40978d-084f-1d4c-b78b-06f02ea3362f Ancestors: GraphicsTests-EG.58 Complements Graphics-mt.515 =============== Diff against GraphicsTests-mt.57 =============== Item was added: + TestCase subclass: #GIFReadWriterTest + instanceVariableNames: 'colorBlack' + classVariableNames: '' + poolDictionaries: '' + category: 'GraphicsTests-Files'! Item was added: + ----- Method: GIFReadWriterTest>>animatedColorFrames (in category 'support') ----- + animatedColorFrames + "Responds with a collection of AnimatedImageFrames + each containing equal-sized rectangles of green, red, + yellow. and black. When animated, these rectangles move + into each other's positions, then back" + | frames topLeft topRight bottomLeft bottomRight revFrames | + frames := OrderedCollection new. + topLeft := (0@0 extent: 200@200). + topRight := (200@0 extent: 400@200). + bottomLeft := (0@200 extent: 200@400). + bottomRight := (200@200 extent: 400@400). + + 0 to: 200 by: 20 do: [ :num | + | newTopLeft newTopRight newBottomLeft newBottomRight canvas | + newTopLeft := topLeft translateBy: (num@0). + newTopRight := topRight translateBy: (0@num). + newBottomLeft := (bottomLeft origin - (0@num)) corner: (bottomLeft extent - (0@num)). + newBottomRight := (bottomRight origin - (num@0)) extent: (bottomLeft extent - (0@0)). + canvas := FormCanvas extent: 400@400 depth: 32. + canvas + fillRectangle: newTopLeft color: Color green; + fillRectangle: newTopRight color: Color red; + fillRectangle: newBottomLeft color: Color yellow; + fillRectangle: newBottomRight color: Color black. + frames add: (AnimatedImageFrame new + form: canvas form; + disposal: #restoreBackground; + delay: 60) ]. + + revFrames := frames reversed. + revFrames do: [ :f | frames add: f ]. + ^ frames! Item was added: + ----- Method: GIFReadWriterTest>>expectedFailures (in category 'failures') ----- + expectedFailures + + ^ #( + testAnimatedColorsOutInRealBlack + testColorsFileOutInRealBlack + testColorsOutInRealBlack + )! Item was added: + ----- Method: GIFReadWriterTest>>setUp (in category 'running') ----- + setUp + + super setUp. + colorBlack := Color r: 0 g: 0 b: 1/255.! Item was added: + ----- Method: GIFReadWriterTest>>testAnimatedColorsOutIn (in category 'tests') ----- + testAnimatedColorsOutIn + "Ensure that the colored rectangles in the created + animated gif are correct at different frames" + | frames outBytes writer reader inBytes activeFrame | + frames := self animatedColorFrames. + + "Write out the GIF bytes to the byte stream" + outBytes := WriteStream on: (ByteArray new). + writer := GIFReadWriter on: outBytes. + frames do: [ :f | writer nextPutFrame: f ]. + writer close. + + "Read the GIF byte stream back into a GIF" + inBytes := ReadStream on: (outBytes contents). + reader := GIFReadWriter on: inBytes. + reader + readHeader; + readBody. + + self assert: reader isAnimated equals: true. + activeFrame := reader frames at: 1. + self assert: (activeFrame form colorAt: 100@100) equals: Color green. + self assert: (activeFrame form colorAt: 300@100) equals: Color red. + self assert: (activeFrame form colorAt: 100@300) equals: Color yellow. + self assert: (activeFrame form colorAt: 300@300) equals: colorBlack. + activeFrame := reader frames at: 11. + self assert: (activeFrame form colorAt: 100@100) equals: Color yellow. + self assert: (activeFrame form colorAt: 300@100) equals: Color green. + self assert: (activeFrame form colorAt: 100@300) equals: colorBlack. + self assert: (activeFrame form colorAt: 300@300) equals: Color red. + ! Item was added: + ----- Method: GIFReadWriterTest>>testAnimatedColorsOutInRealBlack (in category 'tests') ----- + testAnimatedColorsOutInRealBlack + + colorBlack := Color black. + self testAnimatedColorsOutIn.! Item was added: + ----- Method: GIFReadWriterTest>>testColorsFileOutIn (in category 'tests') ----- + testColorsFileOutIn + "Ensure that the colors that are written match up + to the colors that are read in again" + | canvas form outBytes inBytes writer reader | + canvas := FormCanvas extent: 400@400. + canvas + fillRectangle: (0@0 extent: 200@200) color: Color green; + fillRectangle: (200@0 extent: 400@200) color: Color red; + fillRectangle: (0@200 extent: 200@400) color: Color yellow; + fillRectangle: (200@200 extent: 400@400) color: colorBlack. + form := canvas form. + outBytes := FileStream fileNamed: 'testColorsFileOutIn.gif'. + writer := GIFReadWriter on: outBytes. + writer + nextPutImage: form; + close. + inBytes := 'testColorsFileOutIn.gif' asDirectoryEntry readStream binary. + reader := GIFReadWriter on: inBytes. + reader + readHeader; + readBody. + inBytes close. + 'testColorsFileOutIn.gif' asDirectoryEntry delete. + self assert: reader isAnimated equals: false. + self assert: (reader form colorAt: 50@50) equals: Color green. + self assert: (reader form colorAt: 250@50) equals: Color red. + self assert: (reader form colorAt: 50@250) equals: Color yellow. + self assert: (reader form colorAt: 250@250) equals: colorBlack.! Item was added: + ----- Method: GIFReadWriterTest>>testColorsFileOutInRealBlack (in category 'tests') ----- + testColorsFileOutInRealBlack + + colorBlack := Color black. + self testColorsFileOutIn.! Item was added: + ----- Method: GIFReadWriterTest>>testColorsOutIn (in category 'tests') ----- + testColorsOutIn + "Ensure that the colors that are written match up + to the colors that are read in again" + | canvas form outBytes inBytes writer reader | + canvas := FormCanvas extent: 400@400. + canvas + fillRectangle: (0@0 extent: 200@200) color: Color green; + fillRectangle: (200@0 extent: 400@200) color: Color red; + fillRectangle: (0@200 extent: 200@400) color: Color yellow; + fillRectangle: (200@200 extent: 400@400) color: colorBlack. + form := canvas form. + outBytes := WriteStream on: (ByteArray new). + writer := GIFReadWriter on: outBytes. + writer + nextPutImage: form; + close. + outBytes := outBytes contents. + inBytes := ReadStream on: outBytes. + reader := GIFReadWriter on: inBytes. + reader + readHeader; + readBody. + self assert: reader isAnimated equals: false. + self assert: (reader form colorAt: 50@50) equals: Color green. + self assert: (reader form colorAt: 250@50) equals: Color red. + self assert: (reader form colorAt: 50@250) equals: Color yellow. + self assert: (reader form colorAt: 250@250) equals: colorBlack.! Item was added: + ----- Method: GIFReadWriterTest>>testColorsOutInRealBlack (in category 'tests') ----- + testColorsOutInRealBlack + + colorBlack := Color black. + self testColorsOutIn.!

1 0

PositionableStream >> #peekBack behavior
by Eric Gade 04 May '22

04 May '22

Hello, What is the expected behavior for a stream that is at position 1 when you send #peekBack? Intuitively I'd expect to get the first element of the underlying collection as a response. But instead I am getting nil. Here is an example that is failing: ``` elem := #(1 2 3 4). stream := ReadStream on: elem. first := stream next. first = 1. back := stream peekBack. back = first. ``` The last message is currently responding false. In Pharo this returns true, so there are differences. The currently implementation of PositionableStream >> #peekBack is: ``` peekBack "Return the element at the previous position, without changing position. Use indirect messages in case self is a StandardFileStream." | element | self position = 0 ifTrue: [self errorCantGoBack]. self position = 1 ifTrue: [self position: 0. ^ nil]. self skip: -2. element := self next. self skip: 1. ^ element ``` I can see the nil being returned there explicitly, so that's "where it's happening." Should this be the case though? Thanks -- Eric

5 7

Jump to page: