Christoph Thiede uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-ct.336.mcz

==================== Summary ====================

Name: MorphicExtras-ct.336
Author: ct
Time: 18 October 2022, 1:02:37.357471 pm
UUID: 1499f112-9679-fb44-b0fc-112c9d85d772
Ancestors: MorphicExtras-ct.335

Readds the classical BlobMorph by David N Smith. It can be instantiated from the Demo page of the parts bin.

The BlobMorph was part of Squeak until Squeak 3.9.1 after when it was removed as part of a radical clean-up of not used classes (see ReleaseBuilderFor3dot10>>unloadMorphicClasses). Since it has historic value, still makes a nice example, all of its siblings (FishEyeMorph, MovingEyeMorph, et al.) have been readded again, too, and the MorphicExtras package is intended to be unloadable anyway, it makes sense to add it again.

Minor revisions:
* Converts underscore assignments to modern := assignments while preserving the prior timestamps (I hope that was ok?)
* Adds support for Squeak 6.0+ scaleFactor
* Fixes an event handling bug in #containsPoint:

Thanks to Marcel for the pointer!

=============== Diff against MorphicExtras-ct.335 ===============

Item was added:
+ PolygonMorph subclass: #BlobMorph
+ 	instanceVariableNames: 'random velocity sneaky'
+ 	classVariableNames: 'AllBlobs'
+ 	poolDictionaries: ''
+ 	category: 'MorphicExtras-Demo'!
+ 
+ !BlobMorph commentStamp: 'ct 10/18/2022 12:44' prior: 0!
+ The Blob was written by David N Smith.  It started out as a simple test of the CurveMorph and ended up as an oozing, pulsating, repulsive mess which will wander across your screen until killed.  Each instance has its own rate of oozing, so some are faster than others.  It's not good for anything.
+ 
+ Try:
+ 	BlobMorph new openInWorld
+ 
+ 15 Jan 2000 by Bob Arning, a change so that the blob tries to be a color like the color under itself.
+ 16 Jan 2000 by David N Smith, added blob merging: if two blobs meet then one eats the other.
+ 18 Jan 2000 by Sean McGrath, smother color changes.
+ 06 Feb 2000 by Stefan Matthias Aust, refactoring and support for duplication, dragging and translucent colors.!

Item was added:
+ ----- Method: BlobMorph class>>delete: (in category 'instance remembering') -----
+ delete: anInstance
+ 	AllBlobs ifNotNil: [AllBlobs remove: anInstance ifAbsent: []]!

Item was added:
+ ----- Method: BlobMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName:	'Blob'
+ 		categories:		#('Demo')
+ 		documentation:	'A patch of primordial slime'!

Item was added:
+ ----- Method: BlobMorph class>>new (in category 'instance creation') -----
+ new
+ 
+ 	^ self remember: super new
+ 		!

Item was added:
+ ----- Method: BlobMorph class>>remember: (in category 'instance remembering') -----
+ remember: anInstance
+ 	AllBlobs isNil ifTrue: [AllBlobs := IdentitySet new].
+ 	^ AllBlobs add: anInstance!

Item was added:
+ ----- Method: BlobMorph>>adjustColors (in category 'stepping') -----
+ adjustColors
+ 	"Bob Arning <arning at charm.net>"
+ 	"Color mixing - Sean McGrath <sean at email.ces.ucsf.edu>"
+ 	| nearbyColors center r degrees |
+ 	center := bounds center.
+ 	nearbyColors := vertices collect:
+ 		[:each |
+ 		degrees := (each - center) degrees.
+ 		r := (each - center) r.
+ 		Display colorAt: (Point r: r + 6 px degrees: degrees) + center].
+ 		self color: ((self color alphaMixed: 0.95 with: (Color
+ 			r: (nearbyColors collect: [:each | each red]) average
+ 			g: (nearbyColors collect: [:each | each green]) average
+ 			b: (nearbyColors collect: [:each | each blue]) average))
+ 				alpha: self color alpha).
+         sneaky ifFalse: [self color: color negated]!

Item was added:
+ ----- Method: BlobMorph>>bounceOffWalls (in category 'stepping') -----
+ bounceOffWalls
+ 	" Change sign of velocity when we hit a wall of the container "
+ 	| ob sb |
+ 
+ 	" If owned by a handmorph we're being dragged or something;
+ 	  don't bounce since the boundaries are different than our real parent "
+ 	owner isHandMorph ifTrue: [ ^ self ].
+ 
+ 	" If we're entirely within the parents bounds, we don't bounce "
+ 	ob := owner bounds.
+ 	sb := self bounds.
+ 	(ob containsRect: sb) ifTrue: [ ^ self ].
+ 
+ 	" We're partly outside the parents bounds; better bounce or we disappear!! "
+ 	sb top < ob top ifTrue: [ velocity := velocity x @ velocity y abs ].
+ 	sb left < ob left ifTrue: [ velocity := velocity x abs @ velocity y ].
+ 	sb bottom > ob bottom ifTrue: [ velocity := velocity x @ velocity y abs negated ].
+ 	sb right > ob right ifTrue: [ velocity := velocity x abs negated @ velocity y ].
+ !

Item was added:
+ ----- Method: BlobMorph>>containsPoint: (in category 'geometry testing') -----
+ containsPoint: aPoint
+ 	(self color alpha = 1.0 or: [self currentEvent blueButtonPressed])
+ 		ifTrue: [^ super containsPoint: aPoint].
+ 	^ false!

Item was added:
+ ----- Method: BlobMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ random next < 0.25
+ 		ifTrue: [Color random]
+ 		ifFalse: [Color random alpha: random next * 0.4 + 0.4]!

Item was added:
+ ----- Method: BlobMorph>>delete (in category 'submorphs - add/remove') -----
+ delete
+ 	self class delete: self.
+ 	super delete!

Item was added:
+ ----- Method: BlobMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	random := Random new.
+ 	sneaky := random next < 0.75.
+ 	super initialize.
+ ""
+ 	self beSmoothCurve; initializeBlobShape; setVelocity!

Item was added:
+ ----- Method: BlobMorph>>initializeBlobShape (in category 'initialization') -----
+ initializeBlobShape
+ 
+ 	self
+ 		vertices: {59 at 40. 74 at 54. 79 at 74. 77 at 93. 57 at 97. 37 at 97. 22 at 83. 15 at 67. 22 at 50. 33 at 35. 47 at 33} * RealEstateAgent scaleFactor
+ 		color: self color
+ 		borderWidth: 1 px
+ 		borderColor: Color black!

Item was added:
+ ----- Method: BlobMorph>>installModelIn: (in category 'debug and other') -----
+ installModelIn: aWorld
+ 	"Overwritten to not add handles to the receiver."!

Item was added:
+ ----- Method: BlobMorph>>limitRange: (in category 'stepping') -----
+ limitRange: verts
+ 	" limit radius to range 20-120; limit interpoint angle to surrounding angles with max of twice of average separation. "
+ 	| cent new prevn nextn prevDeg nextDeg thisDeg dincr |
+ 
+ 	cent := self bounds center.
+ 	new := Array new: verts size.
+ 	dincr := 360 // verts size.
+ 	verts doWithIndex: [ :pt :n |
+ 
+ 		"Find prev/next points, allowing for wrapping around "
+ 		prevn := n-1 < 1 ifTrue: [new size] ifFalse: [n-1].
+ 		nextn := n+1 > new size ifTrue: [1] ifFalse: [n+1].
+ 
+ 		"Get prev/this/next point's angles "
+ 		prevDeg := ((verts at: prevn)-cent) degrees.
+ 		thisDeg := ((verts at: n)-cent) degrees.
+ 		nextDeg := ((verts at: nextn)-cent) degrees.
+ 
+ 		"Adjust if this is where angles wrap from 0 to 360"
+ 		(thisDeg - prevDeg) abs > 180 ifTrue: [ prevDeg := prevDeg - 360 ].
+ 		(thisDeg - nextDeg) abs > 180 ifTrue: [ nextDeg := nextDeg + 360 ].
+ 
+ 		"Put adjusted point into new collection"
+ 		new at: n put: cent +
+ 			(self selfPolarPointRadius: ((((pt - cent) r) min: 80) max: 20)
+ 				degrees: (((thisDeg min: nextDeg-5) max: prevDeg+5) min: dincr*2+prevDeg)) ].
+ 	^ new
+ !

Item was added:
+ ----- Method: BlobMorph>>maximumVelocity (in category 'initialization') -----
+ maximumVelocity
+ 	^ 6.0!

Item was added:
+ ----- Method: BlobMorph>>mergeBlobs (in category 'stepping') -----
+ mergeBlobs
+ 	"See if we need to merge by checking our bounds against all other Blob
+ 	bounds, then all our vertices against any Blob with overlapping bounds.
+ 	If we find a need to merge, then someone else does all the work."
+ 
+ 	(AllBlobs isNil or: [AllBlobs size < 2]) 
+ 		ifTrue: [^ self].
+ 	AllBlobs
+ 		do:
+ 			[:aBlob |
+ 			aBlob owner == self owner ifTrue:
+ 				[(self bounds intersects: aBlob bounds) ifTrue:
+ 					[vertices do:
+ 						[:aPoint |
+ 						(aBlob containsPoint: aPoint) ifTrue:
+ 							[^ self mergeSelfWithBlob: aBlob atPoint: aPoint]]]]]
+ 		without: self!

Item was added:
+ ----- Method: BlobMorph>>mergeSelfWithBlob:atPoint: (in category 'stepping') -----
+ mergeSelfWithBlob: aBlob atPoint: aPoint
+ 	" It has already been determined that we merge with aBlob; we do all the work here. "
+ 	| v v2 c |
+ 
+ 	c := self bounds center.
+ 
+ 	" Merge the vertices by throwing them all together in one pot "
+ 	v := vertices, aBlob vertices.
+ 
+ 	" Sort the vertices by degrees to keep them in order "
+ 	v := (v asSortedCollection: [ :a :b | (a-c) degrees < (b-c) degrees ]) asArray.
+ 
+ 	" Now, pick half of the vertices so the count stays the same "
+ 	v2 := Array new: v size // 2.
+ 	1 to: v2 size do: [ :n |
+ 		v2 at: n put: (v at: n+n) ].
+ 	v := v2.
+ 
+ 	" Average each contiguous pair to help minimize jaggies "
+ 	2 to: v size do: [ :n |
+ 		v at: n put: ((v at: n) + (v at: n-1)) / 2.0 ].
+ 
+ 	" Remember the new vertices, set a new velocity, then delete the merged blob "
+ 	vertices := v.
+ 	self setVelocity.
+ 	aBlob delete
+ !

Item was added:
+ ----- Method: BlobMorph>>oozeAFewPointsOf: (in category 'stepping') -----
+ oozeAFewPointsOf: verts
+ 	" change some points at random to cause oozing across screen "
+ 	| n v |
+ 
+ 	(verts size sqrt max: 2) floor timesRepeat: [
+ 		n := (verts size * random next) floor + 1.
+ 		v := verts at: n.
+ 		v := (v x + (random next * 2.0 - 1.0))  @ 
+ 			(v y + (random next * 2.0 - 1.0)).
+ 		verts at: n put: v + (velocity * RealEstateAgent scaleFactor) ].!

Item was added:
+ ----- Method: BlobMorph>>selfPolarPointRadius:degrees: (in category 'stepping') -----
+ selfPolarPointRadius: rho degrees: theta
+ 	" Same as Point>>#r:degrees: in Point class except that x and y are not truncated to integers "
+ 	| radians x y |
+ 
+ 	radians := theta asFloat degreesToRadians.
+ 	x := rho asFloat * radians cos.
+ 	y := rho asFloat * radians sin.
+ 	^ Point x: x y: y!

Item was added:
+ ----- Method: BlobMorph>>setConstrainedPosition:hangOut: (in category 'geometry') -----
+ setConstrainedPosition: aPoint hangOut: partiallyOutside
+ 	"Deal with dragging the blob over another blob which results in spontaneous deletations."
+ 
+ 	self owner ifNil: [^ self].
+ 	super setConstrainedPosition: aPoint hangOut: false.
+ 		"note that we keep them from overlapping"!

Item was added:
+ ----- Method: BlobMorph>>setVelocity (in category 'initialization') -----
+ setVelocity
+ 
+ 	velocity :=
+ 		((random next - 0.5) * self maximumVelocity) @ 
+ 		((random next - 0.5) * self maximumVelocity)!

Item was added:
+ ----- Method: BlobMorph>>step (in category 'stepping') -----
+ step
+ 	| verts |
+ 	self comeToFront.
+ 	self mergeBlobs.
+ 	verts := vertices copy.
+ 
+ 	" change two points at random to cause oozing across screen "
+ 	self oozeAFewPointsOf: verts.
+ 
+ 	" limit radius and interpoint angle "
+ 	verts := self limitRange: verts.
+ 
+ 	" Set new vertices; bounce off a wall if necessary "
+ 	self setVertices: verts.
+ 	self bounceOffWalls.
+ 	self adjustColors
+ !

Item was added:
+ ----- Method: BlobMorph>>stepTime (in category 'stepping') -----
+ stepTime
+ 	"Answer the desired time between steps in milliseconds."
+ 
+ 	^ 125!

Item was added:
+ ----- Method: BlobMorph>>veryDeepCopy (in category 'copying') -----
+ veryDeepCopy
+ 	^ self class remember: super veryDeepCopy!