[squeak-dev] The Inbox: Morphic-EG.1829.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Dec 22 00:09:12 UTC 2021


A new version of Morphic was added to project The Inbox:
http://source.squeak.org/inbox/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 at 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)
+ !



More information about the Squeak-dev mailing list