'From Squeakland 3.8.5976 of 25 August 2004 [latest update: #387] on 23 January 2005 at 6:36:02 pm'!
"Change Set:		fixOverlapsAny
Date:			23 January 2005
Author:			Takashi Yamamiya

I think fixOverlapsAny: should return false in these situations;
- Target morphs are in different world.
- The receiver and the argument is same player.
This changeset fixes them.
Also, some unit cases are added.
"!

TestCase subclass: #MorphTest
	instanceVariableNames: 'morph world '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Kernel-Tests'!

!MorphTest methodsFor: 'initialize-release' stamp: 'tak 1/21/2005 11:12'!
getWorld
	^ world
		ifNil: [world := Project newMorphic world]! !

!MorphTest methodsFor: 'initialize-release' stamp: 'tak 1/21/2005 11:12'!
setUp
	morph := Morph new! !

!MorphTest methodsFor: 'initialize-release' stamp: 'tak 1/21/2005 11:12'!
tearDown
	morph delete.
	world
		ifNotNil: [Project deletingProject: world project]! !

!MorphTest methodsFor: 'testing - etoys' stamp: 'tak 1/21/2005 11:31'!
testOverlapAny
	"self debug: #testOverlapAny"
	| p1 p2 |
	p1 _ Morph new assuredPlayer.
	p2 _ EllipseMorph new assuredPlayer.
	"Same position"
	p1 costume position: 0@0.
	p2 costume position: 0@0.
	self assert: (p1 overlapsAny: p2).
	"Different position"
	p1 costume position: 0@0.
	p2 costume position: 500@0.
	self assert: (p1 overlapsAny: p2) not.! !

!MorphTest methodsFor: 'testing - etoys' stamp: 'tak 1/21/2005 11:56'!
testOverlapAnyDeletedPlayer
	"self debug: #testOverlapAnyDeletedPlayer"
	| me friend sibling |
	me := Morph new assuredPlayer assureUniClass; yourself.
	friend := EllipseMorph new assuredPlayer assureUniClass; yourself.
	sibling := friend getNewClone.
	sibling costume delete.
	self getWorld addMorph: me costume.
	"Same position but deleted"
	me costume position: 0 @ 0.
	friend costume position: 0 @ 0.
	sibling costume position: 0 @ 0.
	self assert: (me overlapsAny: friend) not.
	self assert: (me overlapsAny: sibling) not! !

!MorphTest methodsFor: 'testing - etoys' stamp: 'tak 1/21/2005 11:40'!
testOverlapAnyScriptedPlayer
	"self debug: #testOverlapAnyScriptedPlayer"
	| me friend other sibling |
	me := Morph new assuredPlayer assureUniClass; yourself.
	friend := EllipseMorph new assuredPlayer assureUniClass; yourself.
	sibling := friend getNewClone.
	other := EllipseMorph new assuredPlayer assureUniClass; yourself.
	self getWorld addMorph: me costume;
		 addMorph: friend costume;
		 addMorph: other costume;
		 addMorph: sibling costume.
	"myself"
	self assert: (me overlapsAny: me) not.
	"Same position with sibling"
	me costume position: 0 @ 0.
	friend costume position: 500 @ 0.
	other costume position: 500 @ 0.
	sibling costume position: 0@0.
	self assert: (me overlapsAny: friend).
	"Different position with sibling but same class"
	me costume position: 0 @ 0.
	friend costume position: 500 @ 0.
	sibling costume position: 500@ 0.
	other costume position: 0 @ 0.
	self assert: (me overlapsAny: friend) not! !

!MorphTest methodsFor: 'testing - etoys' stamp: 'tak 1/21/2005 11:32'!
testOverlapAnyUnscriptedPlayer
	"self debug: #testOverlapAnyUnscriptedPlayer"
	| p1 p2 p3 |
	p1 := Morph new assuredPlayer.
	p2 := EllipseMorph new assuredPlayer.
	p3 := EllipseMorph new assuredPlayer.
	self getWorld addMorph: p1 costume;
		 addMorph: p2 costume;
		 addMorph: p3 costume.
	"Same class, same position"
	p1 costume position: 0 @ 0.
	p2 costume position: 500 @ 0.
	p3 costume position: 0 @ 0.
	self
		assert: (p1 overlapsAny: p2).
	"Same class, different position"
	p1 costume position: 0 @ 0.
	p2 costume position: 1000 @ 0.
	p3 costume position: 500 @ 0.
	self assert: (p1 overlapsAny: p2) not.
! !


!Player methodsFor: 'misc' stamp: 'tak 1/21/2005 11:59'!
overlaps: aPlayer 
	"Answer whether my costume overlaps that of another player"

	| goalCostume intersection myShadow goalShadow bb myRect goalRect |
	aPlayer ifNil: [^false].
	goalCostume := aPlayer costume.
	costume world == goalCostume world ifFalse: [^false].

	"check if the 2 player costumes intersect"
	intersection := costume bounds intersect: goalCostume bounds.
	(intersection width = 0 or: [intersection height = 0]) 
		ifTrue: [^false]
		ifFalse: 
			["check if the overlapping region is non-transparent"

			"compute 1-bit, black and white versions (stencils) of the intersecting  
			part of each morph's costume"

			myRect := intersection translateBy: 0 @ 0 - costume topLeft.
			myShadow := (costume imageForm contentsOfArea: myRect) stencil.
			goalRect := intersection translateBy: 0 @ 0 - goalCostume topLeft.
			goalShadow := (goalCostume imageForm contentsOfArea: goalRect) stencil.

			"compute a pixel-by-pixel AND of the two stencils.  Result will be black 
			(pixel value = 1) where black parts of the stencils overlap"
			bb := BitBlt toForm: myShadow.
			bb 
				copyForm: goalShadow
				to: 0 @ 0
				rule: Form and.

			"return TRUE if resulting form contains any black pixels"
			^(bb destForm tallyPixelValues second) > 0]! !

!Player methodsFor: 'scripts-standard' stamp: 'tak 1/21/2005 12:08'!
overlapsAny: aPlayer 
	"Answer true if my costume overlaps that of aPlayer, or any of its  
	siblings (if aPlayer is a scripted player)  
	or if my costume overlaps any morphs of the same class (if aPlayer is  
	unscripted)."
	| possibleCostumes itsCostume itsCostumeClass myShadow |
	(self ~= aPlayer
			and: [self overlaps: aPlayer])
		ifTrue: [^ true].
	possibleCostumes := IdentitySet new.
	aPlayer belongsToUniClass
		ifTrue: [aPlayer class
				allSubInstancesDo: [:anInstance | (anInstance ~~ aPlayer
							and: [itsCostume := anInstance costume.
								(itsCostume bounds intersects: costume bounds)
									and: [itsCostume world == costume world]])
						ifTrue: [possibleCostumes add: itsCostume]]]
		ifFalse: [itsCostumeClass := aPlayer costume class.
			self costume world presenter allExtantPlayers
				do: [:ep | ep costume
						ifNotNilDo: [:ea | (ea class == itsCostumeClass
									and: [ea bounds intersects: costume bounds])
								ifTrue: [possibleCostumes add: ea]]]].
	possibleCostumes isEmpty
		ifTrue: [^ false].
	myShadow := costume shadowForm.
	^ possibleCostumes
		anySatisfy: [:m | m overlapsShadowForm: myShadow bounds: costume fullBounds]! !

TestCase subclass: #MorphTest
	instanceVariableNames: 'morph world'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Kernel-Tests'!

!MorphTest reorganize!
('initialize-release' getWorld setUp tearDown)
('testing - into/outOf World' testIntoWorldCollapseOutOfWorld testIntoWorldDeleteOutOfWorld testIntoWorldTransferToNewGuy)
('testing - classification' testIsMorph)
('testing - file in/file out')
('testing - initialization' testOpenInWorld)
('testing - etoys' testOverlapAny testOverlapAnyDeletedPlayer testOverlapAnyScriptedPlayer testOverlapAnyUnscriptedPlayer)
!