'From Cuis 1.0 of 2 October 2009 [latest update: #316] on 8 October 2009 at 11:33:41 am'!

!LightWidget methodsFor: 'compatibility' stamp: 'jmv 10/7/2009 16:58'!
doesLayout
	^false! !

!LightWidget methodsFor: 'private' stamp: 'jmv 10/8/2009 10:48'!
privateFullMoveBy: delta
	"Private!! Relocate me and all of my subMorphs by recursion. Subclasses that implement different coordinate systems may override this method."

	self privateMoveBy: delta! !


!CompositeLW methodsFor: 'private' stamp: 'jmv 10/8/2009 10:48'!
privateFullMoveBy: delta
	"Private!! Relocate me and all of my subMorphs by recursion. Subclasses that implement different coordinate systems may override this method."

	self privateMoveBy: delta.
	submorphs do: [ :m |
		m privateFullMoveBy: delta ]! !


!Morph methodsFor: 'change reporting' stamp: 'jmv 10/8/2009 09:39'!
invalidRect: aRectangle from: aMorph
	| damageRect |
	aRectangle hasPositiveExtent ifFalse: [ ^self ].
	damageRect _ aRectangle.
	aMorph == self ifFalse:[
		"Clip to receiver's clipping bounds if the damage came from a child"
		self clipsSubmorphs 
			ifTrue:[damageRect _ aRectangle intersect: self clippingBounds]].
	owner ifNotNil: [owner invalidRect: damageRect from: self]! !

!Morph methodsFor: 'drawing' stamp: 'jmv 10/8/2009 09:38'!
changeClipSubmorphs
	self clipSubmorphs: self clipsSubmorphs not.! !

!Morph methodsFor: 'drawing' stamp: 'jmv 10/8/2009 09:37'!
clipsSubmorphs
	"Drawing specific. If this property is set, clip the receiver's  
	submorphs to the receiver's clipping bounds."
	^ self
		valueOfProperty: #clipSubmorphs
		ifAbsent: [false]! !

!Morph methodsFor: 'drawing' stamp: 'jmv 10/8/2009 09:38'!
drawSubmorphsOn: aCanvas 
	"Display submorphs back to front"

	| drawBlock |
	submorphs isEmpty ifTrue: [^self].
	drawBlock := [:canvas | submorphs reverseDo: [:m | canvas fullDrawMorph: m]].
	self clipsSubmorphs 
		ifTrue: [aCanvas clipBy: self clippingBounds during: drawBlock]
		ifFalse: [drawBlock value: aCanvas]! !

!Morph methodsFor: 'drawing' stamp: 'jmv 10/8/2009 09:38'!
hasClipSubmorphsString
	"Answer a string that represents the clip-submophs checkbox"
	^ (self clipsSubmorphs
		ifTrue: ['<on>']
		ifFalse: ['<off>'])
		, 'provide clipping' translated! !

!Morph methodsFor: 'layout' stamp: 'jmv 10/8/2009 09:38'!
computeFullBounds
	"Private. Compute the actual full bounds of the receiver"

	(submorphs isEmpty or: [ self clipsSubmorphs ]) ifTrue: [ ^self bounds ].
	^ self bounds quickMerge: self submorphBounds! !

!Morph methodsFor: 'layout' stamp: 'jmv 10/7/2009 16:58'!
doLayoutIn: layoutBounds 
	"Compute a new layout based on the given layout bounds."

	"Note: Testing for #bounds or #layoutBounds would be sufficient to
	figure out if we need an invalidation afterwards but #bounds
	is what we need for all leaf nodes so we use that."

	submorphs isEmpty ifTrue: [ ^fullBounds _ bounds].
	self submorphsDo: [ :m | 
		m doesLayout ifTrue: [
			m layoutProportionallyIn: layoutBounds ]].
	fullBounds _ self computeFullBounds! !

!Morph methodsFor: 'layout' stamp: 'jmv 10/7/2009 16:57'!
doesLayout
	^true! !

!Morph methodsFor: 'private' stamp: 'jmv 10/8/2009 10:49'!
privateFullMoveBy: delta
	"Private!! Relocate me and all of my subMorphs by recursion. Subclasses that implement different coordinate systems may override this method."

	self privateMoveBy: delta.
	submorphs do: [ :m |
		m privateFullMoveBy: delta ]! !


!AlignmentMorph methodsFor: 'drawing' stamp: 'jmv 10/8/2009 09:37'!
clipsSubmorphs
	^true! !


!MorphicEventDispatcher methodsFor: 'dispatching' stamp: 'jmv 10/8/2009 10:02'!
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 transformedBy: (eachChild transformedFrom: 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/8/2009 10:02'!
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 transformedBy: (eachChild transformedFrom: 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/8/2009 10:08'!
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 transformedBy: (eachChild transformedFrom: 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! !


!PasteUpMorph methodsFor: 'drawing' stamp: 'jmv 10/8/2009 09:39'!
drawOn: aCanvas 
	"Draw in order:
	- background color
	- grid, if any
	- background sketch, if any
	- Update and draw the turtleTrails form. See the comment in updateTrailsForm.
	- cursor box if any

	Later (in drawSubmorphsOn:) I will skip drawing the background sketch."

	"draw background fill"
	(self isWorldMorph and: [aCanvas form == Display] and: [(color := self fillStyle) class == TranslucentColor])
		ifTrue: [
			(BitBlt current toForm: Display)
				clipRect: aCanvas clipRect;
				copy: self bounds
				from: 0@0 in: nil
				fillColor: color rule: Form over]
		ifFalse: [ super drawOn: aCanvas]. 

	"draw background sketch."
	backgroundMorph ifNotNil: [
		self clipsSubmorphs ifTrue: [
			aCanvas clipBy: self clippingBounds
				during: [ :canvas | canvas fullDrawMorph: backgroundMorph ]]
			ifFalse: [ aCanvas fullDrawMorph: backgroundMorph ]]! !

!PasteUpMorph methodsFor: 'painting' stamp: 'jmv 10/8/2009 09:39'!
drawSubmorphsOn: aCanvas 
	"Display submorphs back to front, but skip my background sketch."

	| drawBlock |
	submorphs isEmpty ifTrue: [^self].
	drawBlock := [:canvas | submorphs reverseDo: [:m | m ~~ backgroundMorph ifTrue: [ canvas fullDrawMorph: m ]]].
	self clipsSubmorphs 
		ifTrue: [aCanvas clipBy: self clippingBounds during: drawBlock]
		ifFalse: [drawBlock value: aCanvas]! !


!PluggableButtonMorph methodsFor: 'drawing' stamp: 'jmv 10/8/2009 09:37'!
clipsSubmorphs
	^true! !


!SimpleButtonMorph methodsFor: 'drawing' stamp: 'jmv 10/8/2009 09:37'!
clipsSubmorphs
	^true! !

TextMorph removeSelector: #adjustTextAnchor:!
SimpleButtonMorph removeSelector: #clipSubmorphs!
PluggableButtonMorph removeSelector: #clipSubmorphs!
AlignmentMorph removeSelector: #clipSubmorphs!
Morph removeSelector: #clipSubmorphs!
