'From Cuis 2.0 of 24 February 2010 [latest update: #440] on 11 March 2010 at 5:52:38 pm'!
!classDefinition: #TransformMorph category: #'Morphic-Basic'!
Morph subclass: #TransformMorph
	instanceVariableNames: 'transform localBounds txOffset '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Basic'!

!FormCanvas methodsFor: 'accessing' stamp: 'jmv 3/11/2010 11:03'!
formWithOffset

	^ form offset: origin negated! !

!FormCanvas methodsFor: 'private' stamp: 'jmv 3/11/2010 10:59'!
setOrigin: aPoint

	origin _ aPoint! !


!FormCanvas class methodsFor: 'instance creation' stamp: 'jmv 3/11/2010 11:22'!
depth: depth over: aRectangle
	"Color black represents one for 1bpp"

	^ self new
		setForm: (Form extent: aRectangle extent depth: depth);
		setOrigin: aRectangle topLeft negated! !

!FormCanvas class methodsFor: 'instance creation' stamp: 'jmv 3/11/2010 11:21'!
forShadowOver: aRectangle
	"Color black represents one for 1bpp"

	^ self new
		setForm: (Form extent: aRectangle extent depth: 1);
		shadowColor: Color black;
		setOrigin: aRectangle topLeft negated! !

!FormCanvas class methodsFor: 'testing' stamp: 'jmv 3/11/2010 12:13'!
test2
	"FormCanvas test2"

	| baseCanvas p canvas |
	baseCanvas _ FormCanvas extent: 200@200.
	p _ Sensor cursorPoint.
	[Sensor anyButtonPressed] whileFalse: [
		canvas _ baseCanvas copyOffset: (Sensor cursorPoint - p).
		canvas fillColor: Color white.
		canvas line: 10@10 to: 50@30 width: 1 color: Color red.
		canvas frameRectangle: ((20@20) corner: (120@120)) width: 4 color: Color green.
		canvas point: 100@100 color: Color black.
		canvas drawString: 'Hello, World!!' at: 40@40 font: nil color: Color cyan.
		canvas fillRectangle: ((10@80) corner: (31@121)) color: Color magenta.
		canvas fillOval: ((10@80) corner: (31@121)) color: Color cyan.
		canvas frameOval: ((40@80) corner: (61@121)) color: Color blue.
		canvas frameOval: ((70@80) corner: (91@121)) width: 3 color: Color red.
		canvas fillRectangle: ((130@30) corner: (170@80)) color: Color lightYellow.
		canvas showAt: 0@0]! !

!FormCanvas class methodsFor: 'testing' stamp: 'jmv 3/11/2010 12:12'!
test3
	"FormCanvas test3"

	| baseCanvas canvas |
	baseCanvas _ FormCanvas extent: 200@200.
	baseCanvas fillColor: Color white.
	canvas _ baseCanvas copyOffset: 10@10.
	canvas shadowColor: (Color black alpha: 0.5).
	canvas line: 10@10 to: 50@30 width: 1 color: Color red.
	canvas frameRectangle: ((20@20) corner: (120@120)) width: 4 color: Color green.
	canvas point: 100@100 color: Color black.
	canvas drawString: 'Hello, World!!' at: 40@40 font: nil color: Color cyan.
	canvas fillRectangle: ((10@80) corner: (31@121)) color: Color magenta.
	canvas fillOval: ((10@80) corner: (31@121)) color: Color cyan.
	canvas frameOval: ((40@80) corner: (61@121)) color: Color blue.
	canvas frameOval: ((70@80) corner: (91@121)) width: 3 color: Color red.
	canvas fillRectangle: ((130@30) corner: (170@80)) color: Color lightYellow.
	canvas showAt: 0@0! !


!IdentityTransform class methodsFor: 'instance creation' stamp: 'jmv 3/11/2010 17:52'!
release
	Default _ nil! !


!LightWidget methodsFor: 'accessing' stamp: 'jmv 3/8/2010 14:19'!
morphsAt: aPoint behind: aMorph unlocked: aBool 
	"Return all morphs at aPoint that are behind frontMorph; if aBool is true return only unlocked, visible morphs."

	| isBack all |
	all _ (aMorph isNil or: [owner isNil]) 
				ifTrue: ["Traverse down"

					(self fullBounds containsPoint: aPoint) ifFalse: [^#()].
					(aBool and: [self isLocked or: [self visible not]]) ifTrue: [^#()].
					nil]
				ifFalse: ["Traverse up"
					all _ owner 
								morphsAt: (self externalizePositionFromOwner: aPoint to: owner)
								behind: self
								unlocked: aBool.
					WriteStream with: all].
	isBack _ aMorph isNil.
	(isBack and: [self containsPoint: aPoint]) 
		ifTrue: 
			[all ifNil: [^Array with: self].
			all nextPut: self].
	^all ifNil: [#()] ifNotNil: [all contents]! !

!LightWidget methodsFor: 'accessing' stamp: 'jmv 10/9/2009 13:56'!
world
	^owner
		ifNotNil: [ owner world ]! !

!LightWidget methodsFor: 'drawing' stamp: 'jmv 3/11/2010 11:13'!
shadowForm
	"Return a form representing the 'shadow' of the receiver - e.g., all pixels that are occupied by the receiver are one, all others are zero."
	| bnds canvas |
	bnds _ self fullBounds.
	canvas _ Display defaultCanvasClass forShadowOver: bnds.
	canvas fullDrawMorph: self.
	^ canvas formWithOffset! !

!LightWidget methodsFor: 'geometry' stamp: 'jmv 3/11/2010 13:57'!
externalizePosition: pointInSelf to: aReferenceMorph
	"aPoint is in our coordinate system
	answer is in aReferenceMorph's coordinateSystem"

	self == aReferenceMorph
		ifTrue: [ ^pointInSelf ].
	
	"This might actually indicate an error condition. For now, just answer something!!"
	self flag: #jmv.
	owner ifNil: [
		^pointInSelf ].
	
	^owner externalizePosition: pointInSelf to: aReferenceMorph! !

!LightWidget methodsFor: 'geometry' stamp: 'jmv 3/8/2010 14:18'!
externalizePositionFromOwner: pointInOwner to: aReferenceMorph
	"Translate aPoint that is expressedn in owner's coordinates out up to aReferenceMorph's coordinates"
	owner ifNil: [^ pointInOwner].
	^ owner externalizePosition: pointInOwner to: aReferenceMorph! !

!LightWidget methodsFor: 'geometry' stamp: 'jmv 3/11/2010 13:58'!
internalizePosition: pointInReferenceMorph from: aReferenceMorph
	"aPoint is in aReferenceMorph's coordinateSystem
	answer is in our coordinate system"

	self == aReferenceMorph
		ifTrue: [ ^pointInReferenceMorph].

	"This might actually indicate an error condition. For now, just answer something!!"
	self flag: #jmv.
	owner ifNil: [
		^pointInReferenceMorph].

	^owner internalizePosition: pointInReferenceMorph from: aReferenceMorph! !

!LightWidget methodsFor: 'geometry' stamp: 'jmv 3/8/2010 14:26'!
internalizePositionToOwner: pointInReferenceMorph from: aReferenceMorph

	owner ifNil: [^ pointInReferenceMorph].
	^ owner internalizePosition: pointInReferenceMorph from: aReferenceMorph! !

!LightWidget methodsFor: 'halos and balloon help' stamp: 'jmv 10/9/2009 13:00'!
transferHalo: event from: formerHaloOwner
	"Progressively transfer the halo to the next likely recipient"
	| localEvt w |

	"Never transfer halo to top-most world"
	(self isWorldMorph and:[owner isNil]) ifFalse:[
		(self wantsHaloFromClick and:[formerHaloOwner ~~ self]) 
			ifTrue:[^self addHalo: event from: formerHaloOwner]].

	event shiftPressed ifTrue:[
		"Pass it outwards"
		owner ifNotNil:[^owner transferHalo: event from: formerHaloOwner].
		"We're at the top level; throw the event back in to find recipient"
		formerHaloOwner removeHalo.
		^self processEvent: event copy resetHandlerFields.
	].
	"We're at the bottom most level; throw the event back up to the root to find recipient"
	formerHaloOwner removeHalo.
	(w _ self world) ifNil: [ ^self ].
	localEvt _ event externalizedFromOwnerOf: self to: w.
	^w processEvent: localEvt resetHandlerFields.! !

!LightWidget methodsFor: 'meta actions' stamp: 'jmv 10/9/2009 13:03'!
blueButtonDown: anEvent
	"Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph."
	| h doNotDrag |
	h _ anEvent hand halo.
	"Prevent wrap around halo transfers originating from throwing the event back in"
	doNotDrag _ false.
	h ifNotNil:[
		(h innerTarget == self) ifTrue:[doNotDrag _ true].
		(h innerTarget hasOwner: self) ifTrue:[doNotDrag _ true].
		(self hasOwner: h target) ifTrue:[doNotDrag _ true]].

	"cmd-drag on flexed morphs works better this way"
	h _ self addHalo: (anEvent externalizedFromOwnerOf: self to: nil).
	doNotDrag ifTrue:[^self].
	"Initiate drag transition if requested"
	anEvent hand 
		waitForClicksOrDrag: h
		event: (anEvent externalizedFromOwnerOf: self to: nil)
		clkSel: nil
		dblClkSel: nil
		dblClkTimeoutSel: nil
		dragSel: #dragTarget:.
	"Pass focus explicitly here"
	anEvent hand newMouseFocus: h.! !

!LightWidget methodsFor: 'structure' stamp: 'jmv 10/9/2009 14:00'!
outermostWorldMorph
	"Answer the world even if we are not part of it (for example, if we have no owner)"
	^World! !


!CompositeLW methodsFor: 'events-processing' stamp: 'jmv 3/8/2010 14:26'!
handleDropMorph: anEvent
	"Handle a dropping morph."
	| aMorph localPt |
	aMorph _ anEvent contents.
	"Do a symmetric check if both morphs like each other"
	((self wantsDroppedMorph: aMorph event: anEvent)	"I want her"
		and: [aMorph wantsToBeDroppedInto: self])		"she wants me"
		ifFalse: [
				^ self].
	anEvent wasHandled: true.
	"Transform the morph into the receiver's coordinate frame. This is currently incomplete since it only takes the offset into account where it really should take the entire transform."
	localPt _ self internalizePositionToOwner: aMorph referencePosition from: anEvent hand world.
	aMorph referencePosition: localPt.
	self acceptDroppingMorph: aMorph event: anEvent.
	aMorph justDroppedInto: self event: anEvent.! !

!CompositeLW methodsFor: 'submorphs-accessing' stamp: 'jmv 3/8/2010 14:26'!
morphsAt: aPoint behind: aMorph unlocked: aBool 
	"Return all morphs at aPoint that are behind frontMorph; if aBool is true return only unlocked, visible morphs."

	| isBack found all |
	all _ (aMorph isNil or: [owner isNil]) 
				ifTrue: ["Traverse down"

					(self fullBounds containsPoint: aPoint) ifFalse: [^#()].
					(aBool and: [self isLocked or: [self visible not]]) ifTrue: [^#()].
					nil]
				ifFalse: ["Traverse up"
					all _ owner 
								morphsAt: (self externalizePositionFromOwner: aPoint to: owner)
								behind: self
								unlocked: aBool.
					WriteStream with: all].
	isBack _ aMorph isNil.
	self submorphsDo: 
			[:m | 
			isBack 
				ifTrue: [
					found _ m 
								morphsAt: (m internalizePositionToOwner: aPoint from: self)
								behind: nil
								unlocked: aBool.
					found notEmpty 
						ifTrue: 
							[all ifNil: [all _ WriteStream on: #()].
							all nextPutAll: found]].
			m == aMorph ifTrue: [isBack _ true]].
	(isBack and: [self containsPoint: aPoint]) 
		ifTrue: 
			[all ifNil: [^Array with: self].
			all nextPut: self].
	^all ifNil: [#()] ifNotNil: [all contents]! !

!CompositeLW methodsFor: 'halos and balloon help' stamp: 'jmv 10/9/2009 13:00'!
transferHalo: event from: formerHaloOwner
	"Progressively transfer the halo to the next likely recipient"
	| localEvt w |

	"Never transfer halo to top-most world"
	(self isWorldMorph and:[owner isNil]) ifFalse:[
		(self wantsHaloFromClick and:[formerHaloOwner ~~ self]) 
			ifTrue:[^self addHalo: event from: formerHaloOwner]].

	event shiftPressed ifTrue:[
		"Pass it outwards"
		owner ifNotNil:[^owner transferHalo: event from: formerHaloOwner].
		"We're at the top level; throw the event back in to find recipient"
		formerHaloOwner removeHalo.
		^self processEvent: event copy resetHandlerFields.
	].
	self submorphsDo: [ :m |
		localEvt _ event internalizedToOwnerOf: m from: self.
		(m fullContainsPoint: localEvt position) 
			ifTrue:[^m transferHalo: event from: formerHaloOwner].
	].
	"We're at the bottom most level; throw the event back up to the root to find recipient"
	formerHaloOwner removeHalo.
	(w _ self world) ifNil: [ ^self ].
	localEvt _ event externalizedFromOwnerOf: self to: w.
	^w processEvent: localEvt resetHandlerFields! !


!Morph methodsFor: 'drawing' stamp: 'jmv 3/11/2010 10:51'!
drawSubmorphsOn: aCanvas 
	"Display submorphs back to front"
	submorphs isEmpty ifTrue: [ ^ self ].
	self clipsSubmorphs
		ifTrue:
			[ aCanvas
				clipBy: self clippingBounds
				during:
					[ : clippedCanvas | 
					submorphs reverseDo:
						[ : m |  clippedCanvas fullDrawMorph: m ] ] ]
		ifFalse:
			[ submorphs reverseDo:
				[ : m |  aCanvas fullDrawMorph: m ] ]! !

!Morph methodsFor: 'drawing' stamp: 'jmv 3/11/2010 11:23'!
imageForm

	^ self imageForm: Display depth forRectangle: self fullBounds! !

!Morph methodsFor: 'drawing' stamp: 'jmv 3/11/2010 11:22'!
imageForm: depth forRectangle: rect
	| canvas |
	canvas _ Display defaultCanvasClass depth: depth over: rect.
	canvas fullDrawMorph: self.
	^ canvas formWithOffset! !

!Morph methodsFor: 'drawing' stamp: 'jmv 3/11/2010 11:15'!
ownShadowForm
	"Return a form representing the 'shadow' of the receiver, without including submorphs 
	regardless of clipping"
	| canvas bnds |
	bnds _ self bounds.
	canvas _ Display defaultCanvasClass forShadowOver: bnds.
	canvas drawMorph: self.
	^ canvas formWithOffset! !

!Morph methodsFor: 'drawing' stamp: 'jmv 3/11/2010 11:13'!
shadowForm
	"Return a form representing the 'shadow' of the receiver - e.g., all pixels that are occupied by the receiver are one, all others are zero."
	| bnds canvas |
	bnds _ self fullBounds.
	canvas _ Display defaultCanvasClass forShadowOver: bnds.
	canvas fullDrawMorph: self.
	^ canvas formWithOffset! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'jmv 3/8/2010 14:19'!
slideBackToFormerSituation: evt 
	| slideForm formerOwner formerPosition aWorld startPoint endPoint |
	formerOwner _ self formerOwner.
	formerPosition _ self formerPosition.
	aWorld _ evt hand world.
	slideForm _ self imageForm offset: 0 @ 0.
	startPoint _ evt hand fullBounds origin.
	endPoint _formerOwner externalizePositionFromOwner: formerPosition to: aWorld.
	owner removeMorph: self.
	aWorld displayWorld.
	slideForm 
		slideFrom: startPoint
		to: endPoint
		nSteps: 12
		delay: 15.
	formerOwner addMorph: self.
	self position: formerPosition.
	self justDroppedInto: formerOwner event: evt! !

!Morph methodsFor: 'events-processing' stamp: 'jmv 3/8/2010 14:27'!
containsPoint: aPoint event: anEvent
	"Return true if aPoint is considered to be inside the receiver for the given event.
	The default implementation treats locked children as integral part of their owners."
	(self fullBounds containsPoint: aPoint) ifFalse:[^false].
	(self containsPoint: aPoint) ifTrue:[^true].
	self submorphsDo: [ :m|
		(m isLocked and: [ m fullContainsPoint: (m internalizePositionToOwner: aPoint from: self) ]) ifTrue:[^true]].
	^false! !

!Morph methodsFor: 'events-processing' stamp: 'jmv 3/8/2010 14:27'!
handleDropMorph: anEvent
	"Handle a dropping morph."
	| aMorph localPt |
	aMorph _ anEvent contents.
	"Do a symmetric check if both morphs like each other"
	((self wantsDroppedMorph: aMorph event: anEvent)	"I want her"
		and: [aMorph wantsToBeDroppedInto: self])		"she wants me"
		ifFalse: [
				^ self].
	anEvent wasHandled: true.
	"Transform the morph into the receiver's coordinate frame. This is currently incomplete since it only takes the offset into account where it really should take the entire transform."
	localPt _ self internalizePositionToOwner: aMorph referencePosition from: anEvent hand world.
	aMorph referencePosition: localPt.
	self acceptDroppingMorph: aMorph event: anEvent.
	aMorph justDroppedInto: self event: anEvent.
! !

!Morph methodsFor: 'geometry' stamp: 'jmv 3/11/2010 15:09'!
bounds: aRectangle in: referenceMorph
	self revisar.
	"este y los senders... quizas sacar... no se"
	"Return the receiver's bounds as seen by aMorphs coordinate frame"
	^(self externalizePosition: aRectangle origin to: referenceMorph)
		corner:
	(self externalizePosition: aRectangle corner to: referenceMorph)! !

!Morph methodsFor: 'geometry' stamp: 'jmv 3/11/2010 13:57'!
externalizePosition: pointInSelf to: aReferenceMorph
	"aPoint is in our coordinate system
	answer is in aReferenceMorph's coordinateSystem"

	self == aReferenceMorph
		ifTrue: [ ^pointInSelf ].
	
	"This might actually indicate an error condition. For now, just answer something!!"
	self flag: #jmv.
	owner ifNil: [
		^pointInSelf ].
	
	^owner externalizePosition: pointInSelf to: aReferenceMorph! !

!Morph methodsFor: 'geometry' stamp: 'jmv 3/8/2010 14:19'!
externalizePositionFromOwner: pointInOwner to: aReferenceMorph
	"Translate aPoint that is expressedn in owner's coordinates out up to aReferenceMorph's coordinates"
	owner ifNil: [^ pointInOwner].
	^ owner externalizePosition: pointInOwner to: aReferenceMorph! !

!Morph methodsFor: 'geometry' stamp: 'jmv 3/8/2010 14:33'!
externalizeScalar: distanceInSelf to: aReferenceMorph
	"distanceInSelf is a number, and  is in our coordinate system
	answer is in aReferenceMorph's coordinateSystem"

	| p1 p2 |
	p1 _ distanceInSelf@0.
	p2 _ (self externalizePosition: p1 to: aReferenceMorph) - (self externalizePosition: 0@0 to: aReferenceMorph).
	^ p2 x! !

!Morph methodsFor: 'geometry' stamp: 'jmv 3/8/2010 14:17'!
externalizeVector: vectorInSelf to: aReferenceMorph
	"vectorInSelf is a point in our coordinate system that is a distance or difference between 2 positions, and not a position
	answer is in aReferenceMorph's coordinateSystem"

	^(self externalizePosition: vectorInSelf to: aReferenceMorph) - (self externalizePosition: 0@0 to: aReferenceMorph)! !

!Morph methodsFor: 'geometry' stamp: 'jmv 3/11/2010 13:58'!
internalizePosition: pointInReferenceMorph from: aReferenceMorph
	"aPoint is in aReferenceMorph's coordinateSystem
	answer is in our coordinate system"

	self == aReferenceMorph
		ifTrue: [ ^pointInReferenceMorph].

	"This might actually indicate an error condition. For now, just answer something!!"
	self flag: #jmv.
	owner ifNil: [
		^pointInReferenceMorph].

	^owner internalizePosition: pointInReferenceMorph from: aReferenceMorph! !

!Morph methodsFor: 'geometry' stamp: 'jmv 3/8/2010 14:25'!
internalizePositionFromWorld: pointInWorld
	"aPoint is in Worlds's coordinateSystem
	answer is in our coordinate system"
	^self internalizePosition: pointInWorld from: self world! !

!Morph methodsFor: 'geometry' stamp: 'jmv 3/8/2010 14:26'!
internalizePositionToOwner: pointInReferenceMorph from: aReferenceMorph

	owner ifNil: [^ pointInReferenceMorph].
	^ owner internalizePosition: pointInReferenceMorph from: aReferenceMorph! !

!Morph methodsFor: 'geometry' stamp: 'jmv 3/8/2010 14:38'!
internalizeScalar: distanceInReferenceMorph from: aReferenceMorph
	"distanceInReferenceMorph is a number in aReferenceMorph's coordinateSystem
	answer is in our coordinate system"

	| p1 p2 |
	p1 _ distanceInReferenceMorph@0.
	p2 _ (self internalizePosition: p1 from: aReferenceMorph) - (self internalizePosition: 0@0 from: aReferenceMorph).
	^ p2 x! !

!Morph methodsFor: 'geometry' stamp: 'jmv 3/8/2010 14:38'!
internalizeVector: vectorInReferenceMorph from: aReferenceMorph
	"vectorInReferenceMorph is a point in aReferenceMorph's coordinateSystem
	answer is in our coordinate system"

	^(self internalizePosition: vectorInReferenceMorph from: aReferenceMorph) - (self internalizePosition: 0@0 from: aReferenceMorph)! !

!Morph methodsFor: 'geometry' stamp: 'jmv 3/8/2010 14:19'!
positionInWorld

	^ self externalizePositionFromOwner: self position to: self world! !

!Morph methodsFor: 'halos and balloon help' stamp: 'jmv 10/9/2009 13:01'!
transferHalo: event from: formerHaloOwner
	"Progressively transfer the halo to the next likely recipient"
	| localEvt w |

	"Never transfer halo to top-most world"
	(self isWorldMorph and:[owner isNil]) ifFalse:[
		(self wantsHaloFromClick and:[formerHaloOwner ~~ self]) 
			ifTrue:[^self addHalo: event from: formerHaloOwner]].

	event shiftPressed ifTrue:[
		"Pass it outwards"
		owner ifNotNil:[^owner transferHalo: event from: formerHaloOwner].
		"We're at the top level; throw the event back in to find recipient"
		formerHaloOwner removeHalo.
		^self processEvent: event copy resetHandlerFields.
	].
	self submorphsDo:[:m|
		localEvt _ event internalizedToOwnerOf: m from: self.
		(m fullContainsPoint: localEvt position) 
			ifTrue:[^m transferHalo: event from: formerHaloOwner].
	].
	"We're at the bottom most level; throw the event back up to the root to find recipient"
	formerHaloOwner removeHalo.
	(w _ self world) ifNil: [ ^self ].
	localEvt _ event externalizedFromOwnerOf: self to: w.
	^w processEvent: localEvt resetHandlerFields.
! !

!Morph methodsFor: 'meta-actions' stamp: 'jmv 10/9/2009 13:03'!
blueButtonDown: anEvent
	"Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph."
	| h doNotDrag |
	h _ anEvent hand halo.
	"Prevent wrap around halo transfers originating from throwing the event back in"
	doNotDrag _ false.
	h ifNotNil:[
		(h innerTarget == self) ifTrue:[doNotDrag _ true].
		(h innerTarget hasOwner: self) ifTrue:[doNotDrag _ true].
		(self hasOwner: h target) ifTrue:[doNotDrag _ true]].

	"cmd-drag on flexed morphs works better this way"
	h _ self addHalo: (anEvent externalizedFromOwnerOf: self to: nil).
	doNotDrag ifTrue:[^self].
	"Initiate drag transition if requested"
	anEvent hand 
		waitForClicksOrDrag: h
		event: (anEvent externalizedFromOwnerOf: self to: nil)
		clkSel: nil
		dblClkSel: nil
		dblClkTimeoutSel: nil
		dragSel: #dragTarget:.
	"Pass focus explicitly here"
	anEvent hand newMouseFocus: h.! !

!Morph methodsFor: 'structure' stamp: 'jmv 10/9/2009 13:59'!
outermostWorldMorph
	"Answer the world even if we are not part of it (for example, if we have no owner)"
	^World! !

!Morph methodsFor: 'structure' stamp: 'jmv 10/9/2009 13:56'!
world
	^owner
		ifNotNil: [ owner world ]! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'jmv 3/8/2010 14:27'!
morphsAt: aPoint behind: aMorph unlocked: aBool 
	"Return all morphs at aPoint that are behind frontMorph; if aBool is true return only unlocked, visible morphs."

	| isBack found all |
	all _ (aMorph isNil or: [owner isNil]) 
				ifTrue: ["Traverse down"

					(self fullBounds containsPoint: aPoint) ifFalse: [^#()].
					(aBool and: [self isLocked or: [self visible not]]) ifTrue: [^#()].
					nil]
				ifFalse: ["Traverse up"
					all _ owner 
								morphsAt: (self externalizePositionFromOwner: aPoint to: owner)
								behind: self
								unlocked: aBool.
					WriteStream with: all].
	isBack _ aMorph isNil.
	self submorphsDo: 
			[:m | 
			isBack 
				ifTrue: [
					found _ m 
								morphsAt: (m internalizePositionToOwner: aPoint from: self)
								behind: nil
								unlocked: aBool.
					found notEmpty 
						ifTrue: 
							[all ifNil: [all _ WriteStream on: #()].
							all nextPutAll: found]].
			m == aMorph ifTrue: [isBack _ true]].
	(isBack and: [self containsPoint: aPoint]) 
		ifTrue: 
			[all ifNil: [^Array with: self].
			all nextPut: self].
	^all ifNil: [#()] ifNotNil: [all contents]! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'jmv 3/8/2010 14:27'!
morphsAt: aPoint unlocked: aBool do: aBlock
	"Evaluate aBlock with all the morphs starting at the receiver which appear at aPoint. If aBool is true take only visible, unlocked morphs into account."
	| |
	(self fullBounds containsPoint: aPoint) ifFalse:[^self].
	(aBool and:[self isLocked or:[self visible not]]) ifTrue:[^self].
	self submorphsDo: [ :m |
		m morphsAt: (m internalizePositionToOwner: aPoint from: self) unlocked: aBool do: aBlock].
	(self containsPoint: aPoint) ifTrue:[aBlock value: self].! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'jmv 3/8/2010 14:24'!
addMorphFront: aMorph fromWorldPosition: wp

	self addMorphFront: aMorph.
	aMorph position: (self internalizePosition: wp from: self world)! !


!ColorPickerMorph methodsFor: 'private' stamp: 'jmv 3/8/2010 14:26'!
pickColorAt: aGlobalPoint

	| alpha selfRelativePoint pickedColor |
	clickedTranslucency ifNil: [clickedTranslucency _ false].
	selfRelativePoint _ (self internalizePositionToOwner: aGlobalPoint from: nil) - self topLeft.
	(FeedbackBox containsPoint: selfRelativePoint) ifTrue: [^ self].
	(RevertBox containsPoint: selfRelativePoint)
		ifTrue: [^ self updateColor: originalColor feedbackColor: originalColor].

	"check for transparent color and update using appropriate feedback color "
	(TransparentBox containsPoint: selfRelativePoint) ifTrue:
		[clickedTranslucency ifFalse: [^ self].  "Can't wander into translucency control"
		alpha _ (selfRelativePoint x - TransparentBox left - 10) asFloat /
							(TransparentBox width - 20)
							min: 1.0 max: 0.0.
					"(alpha roundTo: 0.01) printString , '   ' displayAt: 0@0." " -- debug"
		self 
			updateColor: (selectedColor alpha: alpha)
			feedbackColor: (selectedColor alpha: alpha).
		^ self].

	"pick up color, either inside or outside this world"
	clickedTranslucency ifTrue: [^ self].  "Can't wander out of translucency control"
	self locationIndicator visible: false. self refreshWorld.
	pickedColor _ Display colorAt: aGlobalPoint.
	self locationIndicator visible: true. self refreshWorld.
	self 
		updateColor: (
			((selectedColor is: #Color) and: [ selectedColor isOpaque not ])
						ifTrue: [ pickedColor alpha: selectedColor alpha ]
						ifFalse: [ pickedColor ]
		)
		feedbackColor: pickedColor! !

!ColorPickerMorph methodsFor: 'private' stamp: 'jmv 3/8/2010 14:26'!
trackColorAt: aGlobalPoint 
	"Before the mouse comes down in a modal color picker, track the color under the cursor, and show it in the feedback box, but do not make transparency changes"

	| selfRelativePoint pickedColor |
	selfRelativePoint _ (self internalizePositionToOwner: aGlobalPoint from: nil) - self topLeft.
	(FeedbackBox containsPoint: selfRelativePoint) ifTrue: [^ self].
	(RevertBox containsPoint: selfRelativePoint)
		ifTrue: [^ self updateColor: originalColor feedbackColor: originalColor].

	"check for transparent color and update using appropriate feedback color "
	(TransparentBox containsPoint: selfRelativePoint) ifTrue: [^ self].

	"pick up color, either inside or outside this world"
	pickedColor _ Display colorAt: aGlobalPoint.
	self updateColor: (pickedColor alpha: originalColor alpha)
		feedbackColor: pickedColor! !


!HaloMorph methodsFor: 'dropping/grabbing' stamp: 'jmv 3/8/2010 14:19'!
startDrag: evt with: dragHandle
	"Drag my target without removing it from its owner."

	| |
	self obtainHaloForEvent: evt andRemoveAllHandlesBut: dragHandle.
	positionOffset _ dragHandle center - (target externalizePositionFromOwner: target position to: owner)! !

!HaloMorph methodsFor: 'event handling' stamp: 'jmv 3/8/2010 14:26'!
mouseMove: evt
	"Drag our target around"
	| thePoint |
	thePoint _ target internalizePositionToOwner: (evt position - positionOffset) from: owner.
	target setConstrainedPosition: thePoint hangOut: true.! !

!HaloMorph methodsFor: 'events' stamp: 'jmv 3/8/2010 14:26'!
dragTarget: event
	"Begin dragging the target"
	| thePoint |
	thePoint _ target internalizePositionToOwner: event position - positionOffset from: owner.
	target setConstrainedPosition: thePoint hangOut: true.
	event hand newMouseFocus: self.! !

!HaloMorph methodsFor: 'events' stamp: 'jmv 3/8/2010 14:19'!
popUpFor: aMorph event: evt
	"This message is sent by morphs that explicitly request the halo on a button click. Note: anEvent is in aMorphs coordinate frame."

	| hand anEvent |
	self flag: #workAround.	"We should really have some event/hand here..."
	anEvent _ evt
				ifNil: 
					[hand _ aMorph world activeHand.
					hand ifNil: [hand _ aMorph world primaryHand]. 
					hand lastEvent internalizedToOwnerOf: aMorph from: nil]
				ifNotNil: 
					[hand _ evt hand.
					evt].
	self target: aMorph.
	hand halo: self.
	hand world addMorphFront: self.
	positionOffset _ anEvent position 
				- (aMorph externalizePositionFromOwner: aMorph position to: owner).
	self startStepping! !

!HaloMorph methodsFor: 'events' stamp: 'jmv 10/9/2009 12:50'!
transferHalo: event
	"Transfer the halo to the next likely recipient"
	target ifNil:[^self delete].
	target transferHalo: (event internalizedToOwnerOf: target from: self) from: target.! !

!HaloMorph methodsFor: 'meta-actions' stamp: 'jmv 3/8/2010 14:19'!
blueButtonDown: event
	"Transfer the halo to the next likely recipient"
	target ifNil:[^self delete].
	event hand obtainHalo: self.
	positionOffset _ event position - (target externalizePositionFromOwner: target position to: owner).
	"wait for drags or transfer"
	event hand 
		waitForClicksOrDrag: self 
		event: event
		clkSel: #transferHalo:
		dblClkSel: nil
		dblClkTimeoutSel: nil
		dragSel: #dragTarget:! !

!HaloMorph methodsFor: 'stepping' stamp: 'jmv 10/9/2009 13:42'!
step
	| newBounds |
	target
		ifNil: [^ self].
	newBounds _ target isWorldMorph
				ifTrue: [target bounds]
				ifFalse: [target worldBoundsForHalo truncated].
	newBounds = self bounds
		ifTrue: [^ self].
	newBounds extent = self bounds extent
		ifTrue: [^ self position: newBounds origin].
	growingOrRotating
		ifFalse: [submorphs size > 1
				ifTrue: [self addHandles]].
	"adjust halo bounds if appropriate"
	self bounds: newBounds! !

!HaloMorph methodsFor: 'private' stamp: 'jmv 3/8/2010 14:26'!
doDrag: evt with: dragHandle
	| thePoint |
	evt hand obtainHalo: self.
	thePoint _ target internalizePositionToOwner: evt position - positionOffset from: owner.
	target setConstrainedPosition: thePoint hangOut: true.
! !

!HaloMorph methodsFor: 'private' stamp: 'jmv 3/8/2010 14:19'!
doRot: evt with: rotHandle
	"Update the rotation of my target if it is rotatable.  Keep the relevant command object up to date."

	| degrees |
self revisar.
	evt hand obtainHalo: self.
	degrees _ (evt cursorPoint - (target externalizePositionFromOwner: target referencePosition to: target world)) degrees.
	degrees _ degrees - angleOffset degrees.
	degrees _ degrees detentBy: 10.0 atMultiplesOf: 90.0 snap: false.
	degrees = 0.0
		ifTrue: [rotHandle color: Color lightBlue]
		ifFalse: [rotHandle color: Color blue].
	rotHandle submorphsDo:
		[:m | m color: rotHandle color makeForegroundColor].
	self removeAllHandlesBut: rotHandle.

	target rotationDegrees: degrees.

	rotHandle position: evt cursorPoint - (rotHandle extent // 2).
	self layoutChanged! !

!HaloMorph methodsFor: 'private' stamp: 'jmv 3/8/2010 14:19'!
startGrow: evt with: growHandle
	"Initialize resizing of my target.  Launch a command representing it, to support Undo"

	| botRt |
	self obtainHaloForEvent: evt andRemoveAllHandlesBut: growHandle.
	botRt _ target externalizePositionFromOwner: target bounds bottomRight to: owner.
	positionOffset _ (self world viewBox containsPoint: botRt)
		ifTrue: [evt cursorPoint - botRt]
		ifFalse: [0@0]! !

!HaloMorph methodsFor: 'private' stamp: 'jmv 3/8/2010 14:19'!
startRot: evt with: rotHandle
	"Initialize rotation of my target if it is rotatable.  Launch a command object to represent the action"

	self obtainHaloForEvent: evt andRemoveAllHandlesBut: rotHandle.
	growingOrRotating _ true.

	self removeAllHandlesBut: rotHandle.  "remove all other handles"
	angleOffset _ evt cursorPoint - (target externalizePositionFromOwner: target referencePosition to: target world).
	angleOffset _ Point
			r: angleOffset r
			degrees: angleOffset degrees - target rotationDegrees

! !


!HandMorph methodsFor: 'drawing' stamp: 'jmv 3/11/2010 12:09'!
nonCachingFullDrawOn: aCanvas
	| shadowForm |
	"A HandMorph has unusual drawing requirements:
		1. the hand itself (i.e., the cursor) appears in front of its submorphs
		2. morphs being held by the hand cast a shadow on the world/morphs below
	The illusion is that the hand plucks up morphs and carries them above the world."
	"Note: This version does not cache an image of the morphs being held by the hand.
	 Thus, it is slower for complex morphs, but consumes less space."

	submorphs isEmpty ifTrue: [^ self drawOn: aCanvas].  "just draw the hand itself"

	"Note: We use a shadow form here to prevent drawing
	overlapping morphs multiple times using the transparent
	shadow color."
	shadowForm _ self shadowForm.

	"draw shadows"
	aCanvas stencil: shadowForm at: shadowForm offset  + self shadowOffset color: (Color black alpha: 0.5).
	
	"draw morphs in front of shadows"
	self drawSubmorphsOn: aCanvas.
	self drawOn: aCanvas.  "draw the hand itself in front of morphs"! !

!HandMorph methodsFor: 'drawing' stamp: 'jmv 3/11/2010 11:09'!
shadowForm
	"Return a 1-bit shadow of my submorphs.  Assumes submorphs is not empty"
	| bnds canvas |
	bnds _ Rectangle merging: (submorphs collect: [:m | m fullBounds]).
	canvas _ Display defaultCanvasClass forShadowOver: bnds.
	self drawSubmorphsOn: canvas.
	^ canvas formWithOffset! !

!HandMorph methodsFor: 'event handling' stamp: 'jmv 3/8/2010 14:27'!
cursorPoint
	"Implemented for allowing embedded worlds in an event cycle to query a hand's position and get it in its coordinates. The same can be achieved by #internalizePositionToOwner:from: but this is simply much more convenient since it will look as if the hand is in the lower world."

	| pos |
	pos _ self position.
	(ActiveWorld isNil or: [ActiveWorld == owner]) ifTrue: [^pos].
	^ActiveWorld internalizePositionToOwner: pos from: owner! !

!HandMorph methodsFor: 'private events' stamp: 'jmv 10/9/2009 12:50'!
sendFocusEvent: anEvent to: focusHolder in: world
	"Send the event to focusHolder, the morph currently holding the focus"
	| result |
	world becomeActiveDuring: [
		ActiveHand _ self.
		ActiveEvent _ anEvent.
		result _ focusHolder handleFocusEvent: 
			(anEvent internalizedToOwnerOf: focusHolder from: self).
	].
	^result! !


!MorphicEvent methodsFor: 'transforming' stamp: 'jmv 10/9/2009 12:57'!
externalizedFromOwnerOf: targetMorph to: outerMorph
	"Return the receiver transformed by the given transform into an outer coordinate system."! !

!MorphicEvent methodsFor: 'transforming' stamp: 'jmv 10/9/2009 12:49'!
internalizedToOwnerOf: targetMorph from: outerMorph
	"Return the receiver transformed by the given transform into a local coordinate system."
! !


!DropEvent methodsFor: 'transforming' stamp: 'jmv 3/8/2010 14:20'!
externalizeFromOwnerOf: targetMorph to: outerMorph
	"Transform the receiver's owner to an outer coordinate system (outerMorph)."
	position _  targetMorph externalizePositionFromOwner: position to: outerMorph! !

!DropEvent methodsFor: 'transforming' stamp: 'jmv 10/9/2009 12:57'!
externalizedFromOwnerOf: targetMorph to: outerMorph
	"Return the receiver transformed by the given transform into an outer coordinate system."
	^self shallowCopy externalizeFromOwnerOf: targetMorph to: outerMorph! !

!DropEvent methodsFor: 'transforming' stamp: 'jmv 3/8/2010 14:26'!
internalizeToOwnerOf: targetMorph from: outerMorph
	"Transform the receiver into a local coordinate system (targetMorph's owner)."
	position _  targetMorph internalizePositionToOwner: position from: outerMorph! !

!DropEvent methodsFor: 'transforming' stamp: 'jmv 10/9/2009 12:57'!
internalizedToOwnerOf: targetMorph from: outerMorph
	"Return the receiver transformed by the given transform into a local coordinate system."
	^self shallowCopy internalizeToOwnerOf: targetMorph from: outerMorph! !


!MorphicEventDispatcher methodsFor: 'dispatching' stamp: 'jmv 10/9/2009 12:50'!
dispatchDefault: anEvent with: aMorph
	"Dispatch the given event. The event will be passed to the front-most visible submorph that contains the position wrt. to the event."
	| localEvt inside |
	"See if we're fully outside aMorphs bounds"
	(aMorph fullBounds containsPoint: anEvent position) ifFalse: [ ^#rejected ]. "outside"

	"Traverse children"
	inside _ false.
	aMorph submorphsDo: [ :eachChild |
		inside ifFalse: [
			localEvt _ anEvent internalizedToOwnerOf: eachChild from: aMorph.
			(eachChild processEvent: localEvt using: self) == #rejected ifFalse: [
				"Not rejected. The event was in some submorph of the receiver"
				inside _ true.
				localEvt wasHandled ifTrue: [ anEvent copyHandlerState: localEvt ].
			]]].

	"Check for being inside the receiver"
	inside ifFalse: [ inside _ aMorph containsPoint: anEvent position event: anEvent ].
	inside ifTrue: [ ^aMorph handleEvent: anEvent ].
	^ #rejected! !

!MorphicEventDispatcher methodsFor: 'dispatching' stamp: 'jmv 10/9/2009 12:50'!
dispatchDropEvent: anEvent with: aMorph
	"Find the appropriate receiver for the event and let it handle it. The dispatch is similar to the default dispatch with one difference: Morphs are given the chance to reject an entire drop operation. If the operation is rejected, no drop will be executed."
	| inside localEvt |

	"Try to get out quickly"
	(aMorph fullBounds containsPoint: anEvent cursorPoint)
		ifFalse: [ ^#rejected ].

	"Give aMorph a chance to repel the dropping morph"
	aMorph rejectDropEvent: anEvent.
	anEvent wasHandled ifTrue:[^self].

	"Go looking if any of our submorphs wants it"
	inside _ false.
	aMorph submorphsDo: [ :eachChild |
		inside ifFalse: [
			localEvt _ anEvent internalizedToOwnerOf: eachChild from: aMorph.
			(eachChild processEvent: localEvt using: self) == #rejected ifFalse: [
				localEvt wasHandled ifTrue: [ ^anEvent wasHandled: true ]. "done"
				inside _ true
			]]].

	inside ifFalse: [ inside _ aMorph containsPoint: anEvent cursorPoint event: anEvent ].
	inside ifTrue: [ ^aMorph handleEvent: anEvent ].
	^#rejected! !

!MorphicEventDispatcher methodsFor: 'dispatching' stamp: 'jmv 10/9/2009 12:50'!
dispatchMouseDown: anEvent with: aMorph
	"Find the appropriate receiver for the event and let it handle it. Default rules:
	* The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event.
	* When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is.
	* When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed.
	* If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event.
"
	| globalPt localEvt handler inside lastHandler |
	"Try to get out quickly"
	globalPt _ anEvent cursorPoint.
	(aMorph fullBounds containsPoint: globalPt) ifFalse: [ ^#rejected ].

	"Install the prospective handler for the receiver"
	lastHandler _ anEvent handler. "in case the mouse wasn't even in the receiver"
	handler _ aMorph handlerForMouseDown: anEvent.
	handler ifNotNil: [ anEvent handler: handler ].

	"Now give our submorphs a chance to handle the event"
	inside _ false.
	aMorph submorphsDo: [ :eachChild |
		inside ifFalse: [
			localEvt _ anEvent internalizedToOwnerOf: eachChild from: aMorph.
			(eachChild processEvent: localEvt using: self) == #rejected ifFalse: [
				"Some child did contain the point so we're part of the top-most chain."
				inside _ true.
				localEvt wasHandled ifTrue: [ anEvent copyHandlerState: localEvt ].
			]]].

	(inside or: [ aMorph containsPoint: anEvent cursorPoint event: anEvent ]) ifTrue:[
		"Receiver is in the top-most unlocked, visible chain."
		handler ifNotNil: [ handler handleEvent: anEvent ].
		"Note: Re-installing the handler is not really necessary but good style."
		anEvent handler: lastHandler.
		^self ].

	"Mouse was not on receiver nor any of its children"
	anEvent handler: lastHandler.
	^#rejected! !


!MouseClickState methodsFor: 'event handling' stamp: 'jmv 10/9/2009 12:50'!
handleEvent: evt from: aHand
	"Process the given mouse event to detect a click, double-click, or drag.
	Return true if the event should be processed by the sender, false if it shouldn't.
	NOTE: This method heavily relies on getting *all* mouse button events."
	| localEvt timedOut isDrag distance |
	timedOut _ (evt timeStamp - firstClickTime) > dblClickTime.
	localEvt _ evt internalizedToOwnerOf: clickClient from: aHand owner.
	distance _ (localEvt position - firstClickDown position) r.
	isDrag _ distance > dragThreshold.
	clickState == #firstClickDown ifTrue: [
		"Careful here - if we had a slow cycle we may have a timedOut mouseUp event"
		(timedOut and:[localEvt isMouseUp not]) ifTrue:[
			"timeout before #mouseUp -> keep waiting for drag or sendYellowButtonActivity if requested"
			clickState _ #firstClickTimedOut.
			(sendYellowButtonActivity not and: [ dragSelector isNil ]) ifTrue: [
				aHand resetClickState.
				self doubleClickTimeout; click "***"].
			^true].
		localEvt isMouseUp ifTrue:[
			(timedOut or: [ dblClickSelector isNil ]) ifTrue:[
				self click.
				aHand resetClickState.
				^true ].
			"Otherwise transfer to #firstClickUp"
			firstClickUp _ evt copy.
			clickState _ #firstClickUp.
			"If timedOut or the client's not interested in dbl clicks get outta here"
			self click.
			aHand handleEvent: firstClickUp.
			^false ].
		isDrag ifTrue: [ "drag start"
			self doubleClickTimeout. "***"
			aHand resetClickState.
			dragSelector "If no drag selector send #click instead"
				ifNil: [ self click ]
				ifNotNil: [ self drag: firstClickDown ].
			^true ].
		^false ].

	clickState == #firstClickTimedOut ifTrue: [
		localEvt isMouseUp ifTrue:[ "neither drag nor double click"
			aHand resetClickState.
			self doubleClickTimeout; click. "***"
			^true ].
		isDrag ifTrue: [ "drag start"
			aHand resetClickState.
			self doubleClickTimeout; drag: firstClickDown. "***"
			^true ].
		"Neither drag nor double click. Simulate yellow button click. This is useful, for example, for pen computers"
		(sendYellowButtonActivity and: [ distance = 0 ]) ifTrue: [
			aHand resetClickState.
			clickClient yellowButtonActivity: evt shiftPressed.
			^true ].
		^false ].

	clickState = #firstClickUp ifTrue:[
		timedOut ifTrue:[
			"timed out after mouseUp - send #click: and mouseUp"
			aHand resetClickState.
			self doubleClickTimeout. "***"
			^true ].
		localEvt isMouseDown ifTrue:[ "double click"
			clickState _ #secondClickDown.
			^false ]].

	clickState == #secondClickDown ifTrue: [
		localEvt isMouseUp ifTrue: ["double click"
			aHand resetClickState.
			self doubleClick.
			^false ]
	].

	^true! !


!MouseOverHandler methodsFor: 'event handling' stamp: 'jmv 10/9/2009 12:50'!
processMouseOver: anEvent 
	"Re-establish the z-order for all morphs wrt the given event"

	| hand localEvt focus evt |
	hand := anEvent hand.
	leftMorphs := mouseOverMorphs asIdentitySet.
	"Assume some coherence for the number of objects in over list"
	overMorphs := WriteStream on: (Array new: leftMorphs size).
	enteredMorphs := WriteStream on: #().
	"Now go looking for eventual mouse overs"
	hand handleEvent: anEvent asMouseOver.
	"Get out early if there's no change"
	(leftMorphs isEmpty and: [enteredMorphs position = 0]) 
		ifTrue: [^leftMorphs := enteredMorphs := overMorphs := nil].
	focus := hand mouseFocus.
	"Send #mouseLeave as appropriate"
	evt := anEvent asMouseLeave.
	"Keep the order of the left morphs by recreating it from the mouseOverMorphs"
	leftMorphs size > 1 
		ifTrue: [leftMorphs := mouseOverMorphs select: [:m | leftMorphs includes: m]].
	leftMorphs do: 
			[:m | 
			(m == focus or: [m hasOwner: focus]) 
				ifTrue: [
					localEvt := evt internalizedToOwnerOf: m from: hand.
					m handleEvent: localEvt]
				ifFalse: [overMorphs nextPut: m]].
	"Send #mouseEnter as appropriate"
	evt := anEvent asMouseEnter.
	enteredMorphs ifNil: 
			["inform: was called in handleEvent:"

			^leftMorphs := enteredMorphs := overMorphs := nil].
	enteredMorphs := enteredMorphs contents.
	enteredMorphs reverseDo: 
			[:m | 
			(m == focus or: [m hasOwner: focus]) 
				ifTrue: 
					[localEvt := evt internalizedToOwnerOf: m  from: hand.
					m handleEvent: localEvt]].
	"And remember the over list"
	overMorphs ifNil: 
			["inform: was called in handleEvent:"

			^leftMorphs := enteredMorphs := overMorphs := nil].
	mouseOverMorphs := overMorphs contents.
	leftMorphs := enteredMorphs := overMorphs := nil! !


!NewParagraph methodsFor: 'editing' stamp: 'jmv 3/11/2010 14:31'!
clickAt: clickPoint for: model
	"Give sensitive text a chance to fire.  Display flash: (100@100 extent: 100@100)."
	| startBlock action target range boxes box |
	action _ false.
	startBlock _ self characterBlockAtPoint: clickPoint.
	(text attributesAt: startBlock stringIndex) do: [ :att | 
		att mayActOnClick ifTrue:
				[(target _ model) ifNil: [ target _ editor morph].
				range _ text rangeOf: att startingAt: startBlock stringIndex.
				boxes _ self selectionRectsFrom: (self characterBlockForIndex: range first) 
							to: (self characterBlockForIndex: range last+1).
				box _ boxes detect: [:each | each containsPoint: clickPoint] ifNone: nil.
				box ifNotNil: [
					box _ editor morph bounds: box in: nil.
					editor morph allOwnersDo: [ :m | box _ box intersect: (m boundsInWorld) ].
					Utilities
						awaitMouseUpIn: box
						repeating: nil
						ifSucceed: [(att actOnClickFor: target in: self at: clickPoint editor: editor) ifTrue: [action _ true]].
					Cursor currentCursor == Cursor webLink ifTrue:[Cursor normal show].
				]]].
	^ action! !


!PolygonMorph methodsFor: 'halo control' stamp: 'jmv 3/11/2010 12:59'!
rotationDegrees: degrees 
	| center |
	center _ self center.
	self setVertices: (vertices collect: [ :v |
		v rotateBy: (degrees - self forwardDirection) degreesToRadians negated about: center ]).
	self forwardDirection: degrees! !

!PolygonMorph methodsFor: 'private' stamp: 'jmv 3/11/2010 11:27'!
borderForm
	"A form must be created for drawing the border whenever the borderColor is translucent."

	| borderCanvas |
	borderForm ifNotNil: [^ borderForm].
	borderCanvas _ Display defaultCanvasClass forShadowOver: bounds.
	self drawBorderOn: borderCanvas.
	borderForm _ borderCanvas form.
	self arrowForms do:
		[:f |  "Eliminate overlap between line and arrowheads if transparent."
		borderForm copy: f boundingBox from: f to: f offset - self position rule: Form erase].
	^ borderForm! !


!ScrollPane methodsFor: 'event handling' stamp: 'jmv 10/9/2009 12:50'!
mouseDown: evt

	evt yellowButtonPressed  "First check for option (menu) click"
		ifTrue: [^ self yellowButtonActivity: evt shiftPressed].
	"If pane is not full, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)"
	scroller hasSubmorphs ifTrue: [
		scroller submorphs last mouseDown:
			(evt internalizedToOwnerOf: scroller from: self)].
	evt hand 
		waitForSimulatedYellow: self 
		event: evt! !

!ScrollPane methodsFor: 'event handling' stamp: 'jmv 10/9/2009 12:50'!
mouseUp: evt
	"If pane is not full, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)"
	scroller hasSubmorphs ifTrue: [
		scroller submorphs last mouseUp: 
		(evt internalizedToOwnerOf: scroller from: self)]! !

!ScrollPane methodsFor: 'pane events' stamp: 'jmv 10/9/2009 12:50'!
mouseMove: evt
	"If pane is not full, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)"
	scroller hasSubmorphs ifTrue: [
		scroller submorphs last mouseMove: 
		(evt internalizedToOwnerOf: scroller from: self)]! !


!PluggableListMorph methodsFor: 'accessing' stamp: 'jmv 3/8/2010 14:27'!
itemFromPoint: aPoint
	"Return the list element (morph) at the given point or nil if outside"
	| ptY |
	scroller hasSubmorphs ifFalse:[^nil].
	(scroller fullBounds containsPoint: aPoint) ifFalse:[^nil].
	ptY _ (scroller firstSubmorph internalizePositionToOwner: aPoint from: self) y.
	"note: following assumes that submorphs are vertical, non-overlapping, and ordered"
	scroller firstSubmorph top > ptY ifTrue:[^nil].
	scroller lastSubmorph bottom < ptY ifTrue:[^nil].
	"now use binary search"
	^scroller 
		findSubmorphBinary:[:item|
			(item top <= ptY and:[item bottom >= ptY])
				ifTrue:[0] "found"
				ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]]! !

!PluggableListMorph methodsFor: 'accessing' stamp: 'jmv 3/8/2010 14:24'!
rowAtLocation: aPoint
	"Return the row at the given point or 0 if outside"
	| pointInListMorphCoords |
	pointInListMorphCoords _ scroller internalizePosition: aPoint from: self.
	^self listMorph rowAtLocation: pointInListMorphCoords.! !


!PluggableTextMorph methodsFor: 'editor access' stamp: 'jmv 3/11/2010 15:04'!
scrollSelectionIntoView: event
	"Scroll my text into view if necessary and return true, else return false"
	| selRects delta selRect rectToTest cpHere |
	selectionInterval _ textMorph editor selectionInterval.
	selRects _ textMorph paragraph selectionRects.
	selRects isEmpty ifTrue: [^ false].
	rectToTest _ selRects first merge: selRects last.
	(event notNil and: [event anyButtonPressed]) ifTrue: [  "Check for autoscroll"
		cpHere _ scroller externalizePosition: event cursorPoint to: self.
		cpHere y <= self top
			ifTrue: [rectToTest _ selRects first topLeft extent: 2@2]
			ifFalse: [cpHere y >= self bottom
					ifTrue: [rectToTest _ selRects last bottomRight extent: 2@2]
					ifFalse: [^ false]]].
	selRect _ scroller bounds: rectToTest in: self.
	selRect height > bounds height
		ifTrue: [^ false].  "Would not fit, even if we tried to scroll"
	(delta _ selRect amountToTranslateWithin: self viewableBounds) y ~= 0 ifTrue: [
		"Scroll end of selection into view if necessary"
		self scrollBy: 0@delta y.
		^ true].
	^ false! !


!SelectionMorph methodsFor: 'drawing' stamp: 'jmv 3/11/2010 11:30'!
drawOn: aCanvas

	| canvas form1 form2 box |
	super drawOn: aCanvas.
	box _ self bounds.
	selectedItems do: [:m | box _ box merge: m fullBounds].
	box _ box expandBy: 1.
	canvas _ Display defaultCanvasClass depth: 8 over: box.
	selectedItems do: [:m | canvas fullDrawMorph: m].
	form1 _ (Form extent: box extent) copyBits: (0@0 extent: box extent) from: canvas form at: 0@0 colorMap: (Color maskingMap: 8).
	form2 _ Form extent: box extent.
	(0@0) fourNeighbors do: [:d | form1 displayOn: form2 at: d rule: Form under].
	form1 displayOn: form2 at: 0@0 rule: Form erase.
	aCanvas stencil: form2
		at: box topLeft
		sourceRect: form2 boundingBox
		color: self borderColor
! !

!SelectionMorph methodsFor: 'initialization' stamp: 'jmv 3/8/2010 14:24'!
extendByHand: aHand
	"Assumes selection has just been created and added to some pasteUp or world"
	| startPoint handle |
	startPoint _ self position.
	handle _ NewHandleMorph new followHand: aHand
		forEachPointDo: [:newPoint | | localPt |
			localPt _ self internalizePosition: newPoint from: self world.
			self bounds: (startPoint rect: localPt)]
		lastPointDo: [:newPoint | selectedItems isEmpty ifTrue: [self delete]
												ifFalse: [self doneExtending]].
	aHand attachMorph: handle.
	handle startStepping.! !

!SelectionMorph methodsFor: 'drag and drop' stamp: 'jmv 3/8/2010 14:19'!
justDroppedInto: newOwner event: evt

	selectedItems isEmpty ifTrue:
		["Hand just clicked down to draw out a new selection"
		^ self extendByHand: evt hand].
	dupLoc ifNotNil: [dupDelta _ self position - dupLoc].
	selectedItems reverseDo: [:m | 
		WorldState addDeferredUIMessage:
			[m referencePosition: (newOwner externalizePositionFromOwner: m referencePosition to: nil).
			newOwner handleDropMorph:
				(DropEvent new setPosition: evt cursorPoint contents: m hand: evt hand)]].
	selectedItems _ nil.
	self removeHalo; delete.
	evt wasHandled: true! !


!SimpleHierarchicalListMorph methodsFor: 'drawing' stamp: 'jmv 3/11/2010 13:29'!
drawLinesOn: aCanvas 
	| lColor clippedCanvas |
	lColor _ self lineColor.
	clippedCanvas _ aCanvas
		copyOffset: scroller txOffset negated truncated
		clipRect: scroller innerBounds.
	scroller submorphs do:
		[ : submorph | 
		(submorph isExpanded or:
			[ (clippedCanvas isVisible: submorph fullBounds) or:
				[ submorph nextSibling notNil and: [ clippedCanvas isVisible: submorph nextSibling ] ] ]) ifTrue:
			[ submorph
				drawLinesOn: clippedCanvas
				lineColor: lColor ] ]! !

!SimpleHierarchicalListMorph methodsFor: 'drawing' stamp: 'jmv 3/11/2010 15:09'!
drawOn: aCanvas

	super drawOn: aCanvas.
	self hasKeyboardFocus ifTrue: [
		aCanvas
			frameRectangle: self focusIndicatorRectangle 
			width: Preferences focusIndicatorWidth
			color: Preferences focusIndicatorColor ].

	selectedMorph  ifNotNil:
		[aCanvas fillRectangle:
			((scroller bounds: selectedMorph bounds in: self)
						intersect: scroller bounds)
				color: color blacker].

	Preferences showLinesInHierarchyViews ifTrue:[
		self drawLinesOn: aCanvas.
	].


! !

!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'jmv 3/8/2010 14:27'!
itemFromPoint: aPoint
	"Return the list element (morph) at the given point or nil if outside"
	| ptY |
	scroller hasSubmorphs ifFalse:[^nil].
	(scroller fullBounds containsPoint: aPoint) ifFalse:[^nil].
	ptY _ (scroller firstSubmorph internalizePositionToOwner: aPoint from: self) y.
	"note: following assumes that submorphs are vertical, non-overlapping, and ordered"
	scroller firstSubmorph top > ptY ifTrue:[^nil].
	scroller lastSubmorph bottom < ptY ifTrue:[^nil].
	"now use binary search"
	^scroller 
		findSubmorphBinary:[:item|
			(item top <= ptY and:[item bottom >= ptY])
				ifTrue:[0] "found"
				ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]]! !

!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'jmv 3/8/2010 14:27'!
mouseDown: evt

	| aMorph |
	evt hand newKeyboardFocus: self.
	aMorph _ self itemFromPoint: evt position.
	(aMorph notNil and:[aMorph inToggleArea: (aMorph internalizePositionToOwner: evt position from: self)])
		ifTrue:[^self toggleExpandedState: aMorph event: evt]. 
	evt yellowButtonPressed  "First check for option (menu) click"
		ifTrue: [^ self yellowButtonActivity: evt shiftPressed].
	aMorph ifNil:[^super mouseDown: evt].
	aMorph highlightForMouseDown.
	evt hand 
		waitForClicksOrDragOrSimulatedYellow: self 
		event: evt 
		clkSel: #click:
		dblClkSel: nil
		dblClkTimeoutSel: nil
		dragSel:  (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil])! !

!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'jmv 3/8/2010 14:27'!
mouseMove: evt

	(self dropEnabled and:[evt hand hasSubmorphs]) 
		ifFalse:[^super mouseMove: evt].
	potentialDropMorph ifNotNil:[
		(potentialDropMorph containsPoint: (potentialDropMorph internalizePositionToOwner: evt position from: self))
			ifTrue:[^self].
	].
	self mouseLeaveDragging: evt.
	(self containsPoint: evt position) 
		ifTrue:[self mouseEnterDragging: evt].! !


!SystemWindow methodsFor: 'events' stamp: 'jmv 3/8/2010 14:27'!
doFastFrameDrag: grabPoint
	"Do fast frame dragging from the given point"
	"modified from doFastFrameDrag."

	| offset newBounds outerWorldBounds |
	outerWorldBounds _ self boundsIn: nil.
	offset _ outerWorldBounds origin - grabPoint.
	newBounds _ outerWorldBounds newRectFrom: [:f | 
		Sensor cursorPoint + offset extent: outerWorldBounds extent].
	self position: (self internalizePositionToOwner: newBounds topLeft from: nil); comeToFront! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'jmv 3/8/2010 14:25'!
doFastWindowReframe: ptName

	| newBounds |
	"For fast display, only higlight the rectangle during loop"
	newBounds _ self bounds newRectButtonPressedDo: [:f | 
		f 
			withSideOrCorner: ptName
			setToPoint: (self internalizePositionFromWorld: Sensor cursorPoint)
			minExtent: self minimumExtent].
	self bounds: newBounds! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'jmv 3/8/2010 14:25'!
spawnPaneFrameHandle: event 
	| resizer localPt side growingPane newBounds adjoiningPanes limit cursor |
	(self world firstSubmorph isKindOf: NewHandleMorph) 
		ifTrue: [^self	"Prevent multiple handles"].
	((self innerBounds withHeight: self labelHeight + 4) 
		containsPoint: event cursorPoint) 
			ifTrue: [^self	"in label or top of top pane"].
	growingPane _ self paneWithLongestSide: [:s | side _ s]
				near: event cursorPoint.
	growingPane ifNil: [^self].
	"don't resize pane side coincident with window side - RAA 5 jul 2000"
	(growingPane perform: side) = (self innerBounds perform: side) 
		ifTrue: [^self].
	(side == #top and: [growingPane top = self panelRect top]) ifTrue: [^self].
	adjoiningPanes _ paneMorphs 
				select: [:pane | pane bounds bordersOn: growingPane bounds along: side].
	limit _ adjoiningPanes isEmpty 
				ifFalse: 
					[(adjoiningPanes collect: [:pane | pane bounds perform: side]) 
						perform: ((#(#top #left) includes: side) ifTrue: [#max] ifFalse: [#min])]
				ifTrue: [self bounds perform: side].
	cursor _ Cursor resizeForEdge: side.
	resizer _ (NewHandleMorph new)
				sensorMode: self fastFramingOn;
				followHand: event hand
					forEachPointDo: 
						[:p | 
						localPt _ self internalizePositionFromWorld: p.
						newBounds _ growingPane bounds 
									withSideOrCorner: side
									setToPoint: localPt
									minExtent: 40 @ self minPaneHeightForReframe
									limit: limit.
						self fastFramingOn 
							ifTrue: 
								["For fast display, only higlight the rectangle during loop"

								Cursor currentCursor == cursor 
									ifFalse: 
										[(event hand)
											visible: false;
											refreshWorld;
											visible: true.
										cursor show].
								newBounds _ growingPane bounds newRectButtonPressedDo: 
												[:f | 
												growingPane bounds 
													withSideOrCorner: side
													setToPoint: (self internalizePositionFromWorld: Sensor cursorPoint)
													minExtent: 40 @ self minPaneHeightForReframe
													limit: limit].].
								self 
									reframePanesAdjoining: growingPane
									along: side
									to: newBounds.
]
					lastPointDo: [:p | ]
					withCursor: cursor.
	event hand world addMorphInLayer: resizer.
	resizer startStepping! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'jmv 3/8/2010 14:25'!
spawnReframeHandle: event 
	"The mouse has crossed a pane border.  Spawn a reframe handle."

	| resizer localPt pt ptName newBounds cursor |
	owner ifNil: [^self	"Spurious mouseLeave due to delete"].
	self isCollapsed ifTrue: [^self].
	((self world ifNil: [^self]) firstSubmorph isKindOf: NewHandleMorph) 
		ifTrue: [^self	"Prevent multiple handles"].
	pt _ event cursorPoint.
	"prevent spurios mouse leave when dropping morphs"
	owner 
		morphsInFrontOf: self
		overlapping: (pt - 2 extent: 4 @ 4)
		do: [:m | (m is: #HandMorph) ifFalse: [(m fullContainsPoint: pt) ifTrue: [^self]]].
	self bounds forPoint: pt
		closestSideDistLen: [ :side :dist :len | 
			"Check for window side adjust"

			dist <= 2 ifTrue: [ptName _ side]].
	ptName ifNil: ["Check for pane border adjust"

			^self spawnPaneFrameHandle: event].
	#(#topLeft #bottomRight #bottomLeft #topRight) do: [ :corner | 
			"Check for window corner adjust"

			(pt dist: (self bounds perform: corner)) < 20 ifTrue: [ptName _ corner]].
	cursor _ Cursor resizeForEdge: ptName.
	resizer _ (NewHandleMorph new)
				sensorMode: self fastFramingOn;
				followHand: event hand
					forEachPointDo: 
						[:p | 
						localPt _ self internalizePositionFromWorld: p.
						newBounds _ self bounds 
									withSideOrCorner: ptName
									setToPoint: localPt
									minExtent: self minimumExtent.
						self fastFramingOn 
							ifTrue: 
								[Cursor currentCursor == cursor 
									ifFalse: 
										[(event hand)
											visible: false;
											refreshWorld;
											visible: true.
										cursor show].
								self doFastWindowReframe: ptName]
							ifFalse: 
								[self bounds: newBounds]]
					lastPointDo: [:p | ]
					withCursor: cursor.
	event hand world addMorphInLayer: resizer.
	resizer startStepping! !


!TextMorph methodsFor: 'anchors' stamp: 'jmv 3/8/2010 14:24'!
anchorMorph: aMorph at: aPoint type: anchorType
	| relPt index newText block |
	aMorph owner == self ifTrue:[self removeMorph: aMorph].
	aMorph textAnchorType: nil.
	aMorph relativeTextAnchorPosition: nil.
	self addMorphFront: aMorph.
	aMorph textAnchorType: anchorType.
	aMorph relativeTextAnchorPosition: nil.
	anchorType == #document ifTrue:[^self].
	relPt _ self internalizePosition: aPoint from: self world.
	index _ (self paragraph characterBlockAtPoint: relPt) stringIndex.
	newText _ Text string: (String value: 1) attribute: (TextAnchor new anchoredMorph: aMorph).
	anchorType == #inline ifTrue:[
		self paragraph replaceFrom: index to: index-1 with: newText.
	] ifFalse:[
		index _ index min: paragraph text size.
		index _ paragraph text string lastIndexOf: Character cr startingAt: index ifAbsent:[0].
		block _ paragraph characterBlockForIndex: index+1.
		aMorph relativeTextAnchorPosition: (relPt x - bounds left) @ (relPt y - block top ).
		self paragraph replaceFrom: index+1 to: index with: newText.
	].
	self fit.! !


!TextMorphForEditView methodsFor: 'event handling' stamp: 'jmv 10/9/2009 12:50'!
autoScrollView: evt
	"This is kind of a hack because the PluggableTextMorph expects me to first expand the selection before auto scrolling will work."
	| localEvt |
	localEvt _ evt internalizedToOwnerOf: self from: editView.
	super mouseMove: localEvt.
	editView scrollSelectionIntoView: localEvt.! !

!TextMorphForEditView methodsFor: 'event handling' stamp: 'jmv 10/9/2009 13:01'!
mouseMove: evt
	| editEvt |
	super mouseMove: evt.
	evt redButtonPressed ifFalse: [^ self].
	editEvt _ evt externalizedFromOwnerOf: self to: editView.
	(editEvt position y between: editView top and: editView bottom) ifFalse:[
		"Start auto-scrolling"
		self startStepping: #autoScrollView:
			at: Time millisecondClockValue
			arguments: (Array with: editEvt)
			stepTime: 100. "fast enough"
	] ifTrue:[
		self stopSteppingSelector: #autoScrollView:.
	].! !


!TransformMorph methodsFor: 'accessing' stamp: 'jmv 3/11/2010 13:29'!
offset
	^ self txOffset + self innerBounds topLeft! !

!TransformMorph methodsFor: 'accessing' stamp: 'jmv 3/11/2010 15:10'!
offset: newOffset
	| o |
	o _ newOffset - self innerBounds topLeft.
	txOffset = o ifFalse: [
		txOffset _ o.
		self changed ]! !

!TransformMorph methodsFor: 'accessing' stamp: 'jmv 3/11/2010 17:46'!
txOffset
	^txOffset! !

!TransformMorph methodsFor: 'change reporting' stamp: 'jmv 3/11/2010 13:34'!
invalidRect: damageRect from: aMorph
	"Translate damage reports from submorphs by the scrollOffset."
	aMorph == self
		ifTrue:[super invalidRect: damageRect from: self]
		ifFalse:[super invalidRect: (((damageRect translateBy: self txOffset negated) intersect: bounds) expandBy: 1) from: self].! !

!TransformMorph methodsFor: 'drawing' stamp: 'jmv 3/11/2010 13:30'!
drawSubmorphsOn: aCanvas

	| clippedCanvas |
	clippedCanvas _ aCanvas
		copyOffset: self txOffset negated truncated
		clipRect: self innerBounds.

	submorphs reverseDo: [ :m | clippedCanvas fullDrawMorph: m]! !

!TransformMorph methodsFor: 'geometry' stamp: 'jmv 3/11/2010 13:45'!
externalizePosition: pointInSelf to: aReferenceMorph
	"aPoint is in our coordinate system
	answer is in aReferenceMorph's coordinateSystem"

	| pointInOwner |
	self == aReferenceMorph
		ifTrue: [ ^pointInSelf ].

	pointInOwner _ pointInSelf - self txOffset.
	
	"This might actually indicate an error condition. For now, just answer something!!"
	self flag: #jmv.
	owner ifNil: [
		^pointInOwner ].
	
	^owner externalizePosition: pointInOwner to: aReferenceMorph! !

!TransformMorph methodsFor: 'geometry' stamp: 'jmv 3/11/2010 14:22'!
internalizePosition: pointInReferenceMorph from: aReferenceMorph
	"aPoint is in aReferenceMorph's coordinateSystem
	answer is in our coordinate system"

	| pointInOwner |
	self == aReferenceMorph
		ifTrue: [ 
			self revisar.
			"Sending #txOffset here is not correct but needed for morphic event translation"
			^pointInReferenceMorph + self txOffset].

	"This might actually indicate an error condition. For now, just answer something!!"
	self flag: #jmv.
	owner ifNil: [
		^pointInReferenceMorph + self txOffset].
	pointInOwner _ owner internalizePosition: pointInReferenceMorph from: aReferenceMorph.

	^ pointInOwner + self txOffset! !

!TransformMorph methodsFor: 'geometry testing' stamp: 'jmv 3/11/2010 13:31'!
containsPoint: aPoint
	(bounds containsPoint: aPoint) ifFalse: [^ false].  "quick elimination"
	self hasSubmorphs
		ifTrue: [
			self submorphsDo: [ :m |
				(m containsPoint: aPoint + self txOffset)
					ifTrue: [^ true]].
			^ false]
		ifFalse: [^ true]! !

!TransformMorph methodsFor: 'initialization' stamp: 'jmv 3/11/2010 17:30'!
initialize
	"initialize the state of the receiver"
	super initialize.
	txOffset _ 0@0! !

!TransformMorph methodsFor: 'private' stamp: 'jmv 3/11/2010 17:46'!
privateFullMoveBy: delta
	"Private!! Relocate me, but not my subMorphs."

	self privateMoveBy: delta.
	txOffset _ txOffset - delta! !


!UserInputEvent methodsFor: 'transforming' stamp: 'jmv 3/8/2010 14:20'!
externalizeFromOwnerOf: targetMorph to: outerMorph
	"Transform the receiver's owner to an outer coordinate system (outerMorph)."
	position _  targetMorph externalizePositionFromOwner: position to: outerMorph! !

!UserInputEvent methodsFor: 'transforming' stamp: 'jmv 10/9/2009 12:57'!
externalizedFromOwnerOf: targetMorph to: outerMorph
	"Return the receiver transformed by the given transform into an outer coordinate system."
	^self shallowCopy externalizeFromOwnerOf: targetMorph to: outerMorph! !

!UserInputEvent methodsFor: 'transforming' stamp: 'jmv 3/8/2010 14:27'!
internalizeToOwnerOf: targetMorph from: outerMorph
	"Transform the receiver into a local coordinate system (targetMorph's owner)."
	position _  targetMorph internalizePositionToOwner: position from: outerMorph! !

!UserInputEvent methodsFor: 'transforming' stamp: 'jmv 10/9/2009 12:57'!
internalizedToOwnerOf: targetMorph from: outerMorph
	"Return the receiver transformed by the given transform into a local coordinate system."
	^self shallowCopy internalizeToOwnerOf: targetMorph from: outerMorph
! !


!MouseMoveEvent methodsFor: 'transforming' stamp: 'jmv 3/8/2010 14:20'!
externalizeFromOwnerOf: targetMorph to: outerMorph
	"Transform the receiver's owner to an outer coordinate system (outerMorph)."
	position _  targetMorph externalizePositionFromOwner: position to: outerMorph.
	startPoint _  targetMorph externalizePositionFromOwner: startPoint to: outerMorph! !

!MouseMoveEvent methodsFor: 'transforming' stamp: 'jmv 3/8/2010 14:27'!
internalizeToOwnerOf: targetMorph from: outerMorph
	"Transform the receiver into a local coordinate system."
	position _  targetMorph internalizePositionToOwner: position from: outerMorph.
	startPoint _  targetMorph internalizePositionToOwner: startPoint from: outerMorph! !


!WorldState methodsFor: 'update cycle' stamp: 'jmv 3/11/2010 10:37'!
doDeferredUpdatingFor: aWorld
        "If this platform supports deferred updates, then make my canvas be the Display (or a rectangular portion of it), set the Display to deferred update mode, and answer true. Otherwise, do nothing and answer false. One can set the class variable DisableDeferredUpdates to true to completely disable the deferred updating feature."
	| properDisplay |
	PasteUpMorph disableDeferredUpdates ifTrue: [^ false].
	(Display deferUpdates: true) ifNil: [^ false].  "deferred updates not supported"
	remoteServer ifNotNil:[
		self assuredCanvas.
		^true].
	properDisplay _ canvas notNil and: [canvas form == Display].
	aWorld == World ifTrue: [  "this world fills the entire Display"
		properDisplay ifFalse: [
			aWorld viewBox: Display boundingBox.    "do first since it may clear canvas"
			self canvas: (Display getCanvas copyClipRect: Display boundingBox).
		]
	] ifFalse: [  "this world is inside an MVC window"
		self revisar.
		self halt.
	].
	^ true
! !

MouseMoveEvent removeSelector: #transformBy:!
UserInputEvent removeSelector: #transformBy:!
UserInputEvent removeSelector: #transformedBy:!
TransformMorph removeSelector: #initTxOffset!
TransformMorph removeSelector: #transform!
TransformMorph removeSelector: #transform:!
TransformMorph removeSelector: #transformFrom:!
!classDefinition: #TransformMorph category: #'Morphic-Basic'!
Morph subclass: #TransformMorph
	instanceVariableNames: 'localBounds txOffset'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Basic'!
TextEditor removeSelector: #transformFrom:!
DropEvent removeSelector: #transformBy:!
DropEvent removeSelector: #transformedBy:!
MorphicEvent removeSelector: #transformedBy:!
HaloMorph removeSelector: #localHaloBoundsFor:!
Morph removeSelector: #globalPointToLocal:!
Morph removeSelector: #imageFormForRectangle:!
Morph removeSelector: #localPointToGlobal:!
Morph removeSelector: #outermostMorphThat:!
Morph removeSelector: #point:from:!
Morph removeSelector: #point:in:!
Morph removeSelector: #pointFromWorld:!
Morph removeSelector: #pointInWorld:!
Morph removeSelector: #transformFrom:!
Morph removeSelector: #transformFromOutermostWorld!
Morph removeSelector: #transformFromWorld!
Morph removeSelector: #transformedFrom:!
LightWidget removeSelector: #point:from:!
LightWidget removeSelector: #point:in:!
LightWidget removeSelector: #pointInWorld:!
LightWidget removeSelector: #transformFrom:!
LightWidget removeSelector: #transformedFrom:!
FormCanvas removeSelector: #asShadowDrawingCanvas!
FormCanvas removeSelector: #asShadowDrawingCanvas:!
FormCanvas removeSelector: #transformBy:clippingTo:during:smoothing:!
FormCanvas removeSelector: #translateBy:during:!
Canvas removeSelector: #asShadowDrawingCanvas!
Canvas removeSelector: #asShadowDrawingCanvas:!
Canvas removeSelector: #transformBy:clippingTo:during:smoothing:!
Canvas removeSelector: #translateBy:during:!
"Postscript:
Leave the line above, and replace the rest of this comment by a useful one.
Executable statements should follow this comment, and should
be separated by periods, with no exclamation points (!!).
Be sure to put any further comments in double-quotes, like this one."
IdentityTransform release.
Smalltalk garbageCollect!

