'From Cuis 5.0 [latest update: #4923] on 14 October 2021 at 12:10:02 am'!

!Morph methodsFor: 'accessing - properties' stamp: 'jmv 10/13/2021 20:48:09'!
wantsToBeOnTop

	^ self valueOfProperty: #wantsToBeOnTop ifAbsent: [ false ].! !

!Morph methodsFor: 'accessing - properties' stamp: 'jmv 10/13/2021 20:48:12'!
wantsToBeOnTop: aBoolean

	self setProperty: #wantsToBeOnTop toValue: aBoolean.! !

!Morph methodsFor: 'private' stamp: 'jmv 10/14/2021 00:09:40'!
privateFixWantsToBeOnTop
	"Ensure that all morphs who #wantsToBeOnTop (i.e. toppers) are above all morphs who not #wantsToBeOnTop.
	Do it without reordering these two subsets.
	Do it in a single pass, and exit as soon as possible."

	| firstMisplacedTopperIndex firstNonTopperIndex topper nonTopper |
	submorphs size < 2 ifTrue: [ ^self ].
	firstMisplacedTopperIndex _ 1.
	firstNonTopperIndex _ 1.
	[
		"Have we actually found a misplaced topper? Fix it!!"
		firstMisplacedTopperIndex = firstNonTopperIndex ifFalse: [
			topper _ submorphs at: firstMisplacedTopperIndex.
			nonTopper _ submorphs at: firstNonTopperIndex.
			submorphs at: firstMisplacedTopperIndex put: nonTopper redrawNeeded.
			submorphs at: firstNonTopperIndex put: topper redrawNeeded.
		].
		"Look for next."
		[ (submorphs at: firstNonTopperIndex) wantsToBeOnTop ] whileTrue: [
			firstNonTopperIndex _ firstNonTopperIndex + 1.
			firstNonTopperIndex = submorphs size ifTrue: [
				"All toppers until the end. Nothing else to do."
				^self ]].
		firstMisplacedTopperIndex _ firstNonTopperIndex+1.
		[ (submorphs at: firstMisplacedTopperIndex) wantsToBeOnTop not ] whileTrue: [
			firstMisplacedTopperIndex _ firstMisplacedTopperIndex + 1.
			firstMisplacedTopperIndex > submorphs size ifTrue: [
				"No more toppers until the end. Nothing else to do."
				^self ]].

	] repeat.! !


!Morph methodsFor: 'private' stamp: 'jmv 10/13/2021 23:18:32'!
privateAddAllMorphs: aCollection atIndex: index
	"Private. Add aCollection of morphs to the receiver"
	| myWorld itsWorld otherSubmorphs |
	(aCollection allSatisfy: [ :m | self canAdd: m]) ifFalse: [
		(self confirm: 'Some requested morph requires VectorGraphics support. Do you want to install and activate it?')
			ifTrue: [
				Feature require: 'VectorGraphics'.
				MorphicCanvas activeSubclass: (Smalltalk at: #VectorCanvas) ]
			ifFalse: [
				^self error: 'We can''t add requested morphs.' ]].
	myWorld _ self world.
	otherSubmorphs _ submorphs copyWithoutAll: aCollection.
	(index between: 0 and: otherSubmorphs size)
		ifFalse: [^ self error: 'index out of range'].
	index = 0
		ifTrue:[	submorphs _ aCollection asArray, otherSubmorphs]
		ifFalse:[	index = otherSubmorphs size
			ifTrue:[	submorphs _ otherSubmorphs, aCollection]
			ifFalse:[	submorphs _ otherSubmorphs copyReplaceFrom: index + 1 to: index with: aCollection ]].
	aCollection do: [:m | | itsOwner |
		itsOwner _ m owner.
		itsOwner ifNotNil: [
			itsWorld _ m world.
			(itsWorld == myWorld) ifFalse: [
				itsWorld ifNotNil: [m redrawNeeded]].
			(itsOwner ~~ self) ifTrue: [
				m owner privateRemove: m.
				m owner removedMorph: m ]].
		m privateOwner: self.
		myWorld ifNotNil: [m redrawNeeded].
		(myWorld == itsWorld) ifFalse: [m intoWorld: myWorld].
		itsOwner == self ifFalse: [
			self addedMorph: m.
			m noteNewOwner: self ].
	].
	self privateFixWantsToBeOnTop.
	self someSubmorphPositionOrExtentChanged! !

!Morph methodsFor: 'private' stamp: 'jmv 10/13/2021 23:18:52'!
privateAddMorph: aMorph atIndex: index position: aPointOrNil

	| oldIndex myWorld itsWorld oldOwner |
	(self canAdd: aMorph) ifFalse: [
		(self confirm: 'The requested morph requires VectorGraphics support. Do you want to install and activate it?')
			ifTrue: [
				Feature require: 'VectorGraphics'.
				MorphicCanvas activeSubclass: (Smalltalk at: #VectorCanvas) ]
			ifFalse: [
				^self error: 'We can''t add requested morph.' ]].
	((index >= 1) and: [index <= (submorphs size + 1)])
		ifFalse: [^ self error: 'index out of range'].
	myWorld _ self world.
	oldOwner _ aMorph owner.
	(oldOwner == self and: [(oldIndex _ submorphs indexOf: aMorph) > 0]) ifTrue: [
		"aMorph's position changes within in the submorph chain"
		oldIndex < index ifTrue:[
			"moving aMorph to back"
			submorphs replaceFrom: oldIndex to: index-2 with: submorphs startingAt: oldIndex+1.
			submorphs at: index-1 put: aMorph.
		] ifFalse:[
			"moving aMorph to front"
			oldIndex-1 to: index by: -1 do:[:i|
				submorphs at: i+1 put: (submorphs at: i)].
			submorphs at: index put: aMorph.
		].
		aPointOrNil ifNotNil: [aMorph privatePosition: aPointOrNil].
	] ifFalse: [
		"adding a new morph"
		oldOwner ifNotNil: [
			itsWorld _ aMorph world.
			itsWorld ifNotNil: [aMorph invalidateBounds].
			oldOwner privateRemove: aMorph.
			oldOwner removedMorph: aMorph.
		].
		aMorph privateOwner: self.
		submorphs _ submorphs copyReplaceFrom: index to: index-1 with: (Array with: aMorph).
		aPointOrNil ifNotNil: [aMorph privatePosition: aPointOrNil].
		(itsWorld == myWorld) ifFalse: [aMorph intoWorld: myWorld].
	].
	myWorld ifNotNil: [
		index = 1
			ifTrue: [aMorph redrawNeeded ]
			ifFalse: [aMorph invalidateBounds]].
	self privateFixWantsToBeOnTop.
	self someSubmorphPositionOrExtentChanged.
	oldOwner == self ifFalse: [
		self addedMorph: aMorph.
		aMorph noteNewOwner: self ]! !

!Morph methodsFor: 'private' stamp: 'jmv 10/13/2021 23:19:03'!
privateMoveBackMorph: aMorph

	| oldIndex myWorld index |
	myWorld _ self world.
	"aMorph's position changes within in the submorph chain"
	"moving aMorph to front"
	oldIndex _ submorphs indexOf: aMorph.
	"moving aMorph to back"
	index _ submorphs size.
	submorphs replaceFrom: oldIndex to: index-1 with: submorphs startingAt: oldIndex+1.
	submorphs at: index put: aMorph.
	myWorld ifNotNil: [aMorph redrawNeeded].
	self privateFixWantsToBeOnTop.
	self someSubmorphPositionOrExtentChanged.! !

!Morph methodsFor: 'private' stamp: 'jmv 10/13/2021 23:14:40'!
privateMoveFrontMorph: aMorph

	| oldIndex myWorld |
	myWorld _ self world.
	"aMorph's position changes within in the submorph chain"
	"moving aMorph to front"
	oldIndex _ submorphs indexOf: aMorph.
	oldIndex-1 to: 1 by: -1 do: [ :i |
		submorphs at: i+1 put: (submorphs at: i)].
	submorphs at: 1 put: aMorph.
	myWorld ifNotNil: [aMorph redrawNeeded].
	self privateFixWantsToBeOnTop.
	self someSubmorphPositionOrExtentChanged.! !

!methodRemoval: Morph #privateFixWantsToBeOnTop2 stamp: 'jmv 10/13/2021 23:22:17'!
Morph removeSelector: #privateFixWantsToBeOnTop2!
!methodRemoval: Morph #privateFixWantsToBeOnTop1 stamp: 'jmv 10/13/2021 23:22:10'!
Morph removeSelector: #privateFixWantsToBeOnTop1!
