'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 5 August 2008 at 8:48:39 am'!

!EventManager commentStamp: 'jmv 7/24/2008 10:00' prior: 0!
Part of update 5005u16-Events.cs:

"Change Set:		Events
Date:			11 February 2002
Author:			Rob Withers et al.

Published to 3.3a as 4756Events.cs

The NuBlue events code. Finally..."

The new event model, originally from VisualSmalltalk.
This includes #when:send:to: and friends, in Object (generic implementation) and EventManager (optimized implementation).
It renders the old change/update mechanism in Object and Model as obsolete, although still used.
Includes code from John Sarkela (reThink), Andres Valloud (SqR) and Stefan Matthias Aust (sma).
7/24/2008 jmv!

!classDefinition: #ActiveModel category: #'System-Object Events'!
EventManager subclass: #ActiveModel
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Object Events'!

!ActiveModel commentStamp: '<historical>' prior: 0!
My only purpose is to provide a better name for EventManager.

Any object can be a model, as Object supports #when:send:to: . But ActiveModels take an active attitude, having an optimized implementation that requires an instance variable (not unlike the old Model class, used for the obsolete change / update mechanism).

Models that need the #when:send:to: event model, and want an optimized version should inherit from me.

For example, models for Morphic 3 and LightWidgets should inherit from me if possible.!

!classDefinition: #ImageLW category: #'LightWidgets-Kernel'!
LightWidget subclass: #ImageLW
	instanceVariableNames: 'form stretched'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'LightWidgets-Kernel'!

!ImageLW commentStamp: '<historical>' prior: 0!
My instances show a Form.!

!classDefinition: #MenuItemLW category: #'LightWidgets-Widgets'!
ButtonLW subclass: #MenuItemLW
	instanceVariableNames: 'selectedForeColor foreColor selectedBackColor backColor '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'LightWidgets-Widgets'!
!classDefinition: #MenuListLW category: #'LightWidgets-Widgets'!
ListLW subclass: #MenuListLW
	instanceVariableNames: 'backColor scrollBarColor scrollThumbColor'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'LightWidgets-Widgets'!

!MenuListLW commentStamp: '<historical>' prior: 0!
A list usually used as part of a menu.!


!Model commentStamp: '<historical>' prior: 0!
Provides a superclass for classes that function as models.  The only behavior provided is fast dependents maintenance, which bypasses the generic DependentsFields mechanism.  1/23/96 sw.

This class does not provide specific support #when:send:to: and therefore it is of no value for the Morphic 3 / LightWidgets programming style. See ActiveModel instead. 7/24/2008 jmv.!


!Object methodsFor: 'message handling' stamp: 'jmv 8/2/2008 09:45'!
disableCode: aBlock
	"Use this method instead of commenting temporarily disabled code.
	This way, it will be accessible with senders, references to variables, etc.
	Besides, you'll avoid problems when the code to disable has comments!!"! !


!ActiveModel methodsFor: 'initialization' stamp: 'jmv 7/24/2008 10:49'!
initialize
	super initialize! !


!LightWidget methodsFor: 'geometry' stamp: 'jmv 7/25/2008 15:41'!
height: aNumber

	self extent: self width @ aNumber asInteger! !

!LightWidget methodsFor: 'view of a model or target' stamp: 'jmv 8/4/2008 17:32'!
safeModelChanged
	"The model changed is some way.
	This is usually the place to call #targetAspect to fetch the current value of the aspect from the
		model, and to store it in some Model Extension.
	We must update all Model Extension instance variables with values from the model (i.e. target)
		or with appropriate defaults.
	We must update ourselves and all subviews to reflect the model's new state
	This method could be called from a process that is not the UI process.
	Do the update in the UI process, in the inter-cycle pause."

	Processor activeProcess == ProjectX uiProcessX
		ifTrue: [ self modelChanged ]
		ifFalse: [
			OldWorldState addDeferredUIMessage:  [
				self modelChanged ]]! !


!ButtonLW methodsFor: 'accessing' stamp: 'jmv 7/24/2008 11:25'!
font: aFont
	font _ aFont! !


!CompositeLW methodsFor: 'submorphs-add/remove' stamp: 'jmv 7/24/2008 13:43'!
removeAllMorphs
	| oldMorphs myWorld |
	myWorld _ self world.
	myWorld notNil ifTrue:[self invalidRect: self fullBounds].
	submorphs do: [:m | m privateOwner: nil].
	oldMorphs _ submorphs.
	submorphs _ EmptyArray.
	oldMorphs do: [ :m | self removedMorph: m ].
	self layoutChanged! !

!CompositeLW methodsFor: 'submorphs-add/remove' stamp: 'jmv 7/24/2008 13:48'!
removeMorph: aMorph
	"Remove the given morph from my submorphs"
	| aWorld |
	aMorph owner == self ifFalse:[^self].
	aWorld := self world.
	aWorld ifNotNil:[
		self privateInvalidateMorph: aMorph.
	].
	self privateRemove: aMorph.
	aMorph privateOwner: nil.
	self removedMorph: aMorph.
	self layoutChanged! !

!CompositeLW methodsFor: 'private' stamp: 'jmv 7/24/2008 13:47'!
privateAddMorph: aMorph atIndex: index

	| oldIndex myWorld itsWorld oldOwner |
	((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.
		].
	] ifFalse:[
		"adding a new morph"
		oldOwner ifNotNil:[
			itsWorld _ aMorph world.
			itsWorld ifNotNil: [self privateInvalidateMorph: aMorph].
			oldOwner privateRemove: aMorph.
			oldOwner removedMorph: aMorph.
		].
		aMorph privateOwner: self.
		submorphs _ submorphs copyReplaceFrom: index to: index-1 with: (Array with: aMorph).
		(itsWorld == myWorld) ifFalse: [aMorph intoWorld: myWorld].
	].
	myWorld ifNotNil:[self privateInvalidateMorph: aMorph].
	self layoutChanged.
	oldOwner == self ifFalse: [
		self addedMorph: aMorph.
		aMorph noteNewOwner: self ].
! !


!ImageLW methodsFor: 'accessing' stamp: 'jmv 7/25/2008 13:41'!
form: aForm
	form _ aForm.
	self layoutChanged! !

!ImageLW methodsFor: 'initialization' stamp: 'jmv 7/25/2008 14:01'!
initialize
	super initialize.
	form _ Form makeStar.
	bounds _ 10@10 extent: form extent.
	self generateStretchedForm! !

!ImageLW methodsFor: 'drawing' stamp: 'jmv 7/25/2008 13:59'!
drawOn: aCanvas 
	aCanvas drawImage: stretched at: bounds topLeft ! !

!ImageLW methodsFor: 'drawing' stamp: 'jmv 7/25/2008 14:00'!
generateStretchedForm
	| scale smoothPix pair |
	scale _ bounds extent / form extent.
	smoothPix := (scale x < 1.0 or: [scale y < 1.0]) 
		ifTrue: [2]
		ifFalse: [1].
	stretched := scale = (1 @ 1) 
				ifTrue: [form]
				ifFalse: [
					pair := WarpBlt current 
								rotate: form
								degrees: 0
								center: form boundingBox center
								scaleBy: scale
								smoothing: smoothPix.
					pair first]! !

!ImageLW methodsFor: 'layout' stamp: 'jmv 7/25/2008 13:38'!
layoutChanged
	"Update rotatedForm and compute new bounds."
	self changed.
	self generateStretchedForm.
	super layoutChanged.
	self changed! !

!ImageLW methodsFor: 'geometry' stamp: 'jmv 7/25/2008 14:12'!
bounds: aPoint
	super bounds: aPoint.
	self layoutChanged! !


!LabelLW methodsFor: 'accessing' stamp: 'jmv 7/31/2008 23:08'!
font: aFont

	font _ aFont.
	self changed! !

!LabelLW methodsFor: 'accessing' stamp: 'jmv 7/31/2008 23:09'!
fontColor: aColor

	fontColor _ aColor.
	self changed! !

!LabelLW methodsFor: 'accessing' stamp: 'jmv 8/4/2008 09:40'!
label: aString
	self target: (aString ifNil: ['']) aspect: nil aspectAdaptor: nil! !


!ListLW methodsFor: 'focus handling' stamp: 'jmv 7/31/2008 17:11'!
gotNavigationFocus: aSubmorph
	"Default is to do nothing."
	
	| delta |
	delta _ aSubmorph bounds amountToTranslateWithin: bounds.
	delta = (0@0) ifFalse: [
		submorphs do: [ :m |
			m privateFullMoveBy: delta].
		self changed]! !

!ListLW methodsFor: 'submorphs-add/remove' stamp: 'jmv 7/25/2008 15:33'!
addItem: aString action: aSymbol

	^self addItem: aString height: nil font: nil target: owner action: aSymbol argument: nil! !

!ListLW methodsFor: 'submorphs-add/remove' stamp: 'jmv 7/25/2008 15:33'!
addItem: aString action: aSymbol argument: anotherObject

	^self
		addItem: aString 
		height: nil 
		font: nil 
		target: owner 
		action: aSymbol 
		argument: anotherObject! !

!ListLW methodsFor: 'submorphs-add/remove' stamp: 'jmv 7/25/2008 15:34'!
addItem: aString height: h font: f action: aSymbol

	^self addItem: aString height: h font: f target: owner action: aSymbol argument: nil! !

!ListLW methodsFor: 'submorphs-add/remove' stamp: 'jmv 7/29/2008 13:51'!
addItem: aString height: h font: f action: aSymbol argument: anObject

	^self addItem: aString height: h font: f target: owner action: aSymbol argument: anObject! !

!ListLW methodsFor: 'submorphs-add/remove' stamp: 'jmv 7/31/2008 17:12'!
addItem: aString height: h font: f target: anObject action: aSymbol argument: anotherObject

	| item |
	item _ self defaultItemClass 
		target: anObject action: aSymbol argument: anotherObject label: aString.
	f notNil ifTrue: [ item font: f ].
	h notNil ifTrue: [ item height: h ].
	item width: self itemWidth.
	self addMorph: item.
	^item! !

!ListLW methodsFor: 'submorphs-add/remove' stamp: 'jmv 7/25/2008 15:33'!
addItem: aString target: anObject action: aSymbol

	^self addItem: aString height: nil font: nil target: anObject action: aSymbol argument: nil! !

!ListLW methodsFor: 'submorphs-add/remove' stamp: 'jmv 7/29/2008 12:28'!
addItem: aString target: anObject action: aSymbol argument: anotherObject

	| item |
	item _ self defaultItemClass 
		target: anObject action: aSymbol argument: anotherObject label: aString.
	item width: self itemWidth.
	self addMorph: item.
	^item! !

!ListLW methodsFor: 'submorphs-add/remove' stamp: 'jmv 7/25/2008 15:27'!
addMorph: aMorph
	| p |
	p _ submorphs isEmpty 
		ifFalse: [submorphs last bounds bottomLeft]
		ifTrue: [bounds topLeft].
	self addMorphBack: aMorph.
	aMorph position: p! !

!ListLW methodsFor: 'accessing' stamp: 'jmv 7/29/2008 12:29'!
itemWidth
	^self width-20! !

!ListLW methodsFor: 'geometry' stamp: 'jmv 7/29/2008 12:26'!
scrollInterval
	"Answer an interval that is a subset of [0.0 ... 1.0]
	It represents the actually visible part of the submorphs
	In a sense, it is the vertical scroll position"

	| b top bottom subTop subBottom thumbTop thumbBottom scale |
	top _ bounds top.
	bottom _ bounds bottom.
	subTop _ top.
	subBottom _ bottom.
	self submorphsDo:[:m |
		b _ m bounds.
		subTop _ subTop min: b top.
		subBottom _ subBottom max: b bottom ].
	scale _ 1.0 /  (subBottom - subTop) * (bottom - top ).
	thumbTop _ 1.0 * top - subTop * scale + top.
	thumbBottom _ 1.0 * bottom - subTop * scale + top.
	^ Interval from: thumbTop rounded to: thumbBottom rounded! !


!MenuItemLW methodsFor: 'accessing' stamp: 'jmv 7/24/2008 11:34'!
backColor
	^self hasNavigationFocus
		ifTrue: [ selectedBackColor ]
		ifFalse: [ backColor ]! !

!MenuItemLW methodsFor: 'accessing' stamp: 'jmv 7/24/2008 11:38'!
backColor: aColor
	backColor _ aColor! !

!MenuItemLW methodsFor: 'accessing' stamp: 'jmv 7/24/2008 11:35'!
foreColor
	^self hasNavigationFocus
		ifTrue: [ selectedForeColor ]
		ifFalse: [ foreColor ]! !

!MenuItemLW methodsFor: 'accessing' stamp: 'jmv 7/24/2008 11:38'!
foreColor: aColor
	foreColor _ aColor! !

!MenuItemLW methodsFor: 'accessing' stamp: 'jmv 7/25/2008 11:03'!
selectedBackColor: aColor
	selectedBackColor _ aColor! !

!MenuItemLW methodsFor: 'accessing' stamp: 'jmv 7/25/2008 11:03'!
selectedForeColor: aColor
	selectedForeColor _ aColor! !

!MenuItemLW methodsFor: 'initialization' stamp: 'jmv 7/24/2008 11:34'!
initialize
	super initialize.
	bounds _ 10@10 extent: 100@30.
	label _ 'item text'.
	foreColor _ Color blue.
	backColor _ Color lightBlue.
	selectedForeColor _ Color white.
	selectedBackColor _ Color blue! !

!MenuItemLW methodsFor: 'drawing' stamp: 'jmv 7/24/2008 11:31'!
drawOn: aCanvas
	aCanvas fillRectangle: bounds color: self backColor.
	aCanvas drawString: label at: bounds topLeft + (5@2) font: font color: self foreColor! !


!MenuListLW methodsFor: 'drawing' stamp: 'jmv 7/29/2008 15:02'!
drawOn: aCanvas

	| thumb |
	aCanvas fillRectangle: bounds color: backColor.
	thumb _ self scrollInterval.
	(thumb first = bounds top and: [thumb last = bounds bottom ]) ifFalse: [
		aCanvas
			fillRectangle: (bounds right - 18 @ bounds top corner: bounds right @ bounds bottom)
			color: scrollBarColor.
		aCanvas
			fillRectangle: (bounds right - 18 @ thumb first corner: bounds right @ thumb last)
			color: scrollThumbColor ]! !

!MenuListLW methodsFor: 'initialization' stamp: 'jmv 7/29/2008 13:01'!
initialize
	super initialize.
	backColor _ Color lightGray.
	scrollBarColor _ backColor darker.
	scrollThumbColor _ scrollBarColor darker! !

!MenuListLW methodsFor: 'accessing' stamp: 'jmv 7/29/2008 12:43'!
backColor: aColor
	backColor _ aColor! !

!MenuListLW methodsFor: 'accessing' stamp: 'jmv 7/29/2008 13:01'!
scrollBarColor: aColor
	scrollBarColor _ aColor! !

!MenuListLW methodsFor: 'accessing' stamp: 'jmv 7/29/2008 13:01'!
scrollThumbColor: aColor
	scrollThumbColor _ aColor! !


!CompositeMorph methodsFor: 'submorphs-add/remove' stamp: 'jmv 7/24/2008 13:43'!
removeAllMorphs
	| oldMorphs myWorld |
	myWorld _ self world.
	myWorld notNil ifTrue:[self invalidRect: self fullBounds].
	submorphs do: [:m | m privateOwner: nil].
	oldMorphs _ submorphs.
	submorphs _ EmptyArray.
	oldMorphs do: [ :m | self removedMorph: m ].
	self layoutChanged! !

!CompositeMorph methodsFor: 'submorphs-add/remove' stamp: 'jmv 7/24/2008 13:48'!
removeMorph: aMorph
	"Remove the given morph from my submorphs"
	| aWorld |
	aMorph owner == self ifFalse:[^self].
	aWorld := self world.
	aWorld ifNotNil:[
		self privateInvalidateMorph: aMorph.
	].
	self privateRemove: aMorph.
	aMorph privateOwner: nil.
	self removedMorph: aMorph.
	self layoutChanged! !

!CompositeMorph methodsFor: 'private' stamp: 'jmv 7/24/2008 13:47'!
privateAddMorph: aMorph atIndex: index

	| oldIndex myWorld itsWorld oldOwner |
	((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.
		].
	] ifFalse:[
		"adding a new morph"
		oldOwner ifNotNil:[
			itsWorld _ aMorph world.
			itsWorld ifNotNil: [self privateInvalidateMorph: aMorph].
			oldOwner privateRemove: aMorph.
			oldOwner removedMorph: aMorph.
		].
		aMorph privateOwner: self.
		submorphs _ submorphs copyReplaceFrom: index to: index-1 with: (Array with: aMorph).
		(itsWorld == myWorld) ifFalse: [aMorph intoWorld: myWorld].
	].
	myWorld ifNotNil:[self privateInvalidateMorph: aMorph].
	self layoutChanged.
	oldOwner == self ifFalse: [
		self addedMorph: aMorph.
		aMorph noteNewOwner: self ].
! !


!OldMorph methodsFor: 'events-accessing' stamp: 'jmv 7/24/2008 09:25'!
actionMap
	"Answer an action map"
	"Do NOT duplicate this in Morphic3 / LightWidgets
	Views should not trigger events!!"

	| actionMap |
	actionMap := self valueOfProperty: #actionMap.
	actionMap ifNil:
		[actionMap _ self createActionMap].
	^ actionMap! !

!OldMorph methodsFor: 'events-accessing' stamp: 'jmv 7/24/2008 09:25'!
updateableActionMap
	"Answer an updateable action map, saving it in my #actionMap property"
	"Do NOT duplicate this in Morphic3 / LightWidgets
	Views should not trigger events!!"
	
	| actionMap |
	actionMap := self valueOfProperty: #actionMap.
	actionMap ifNil:
		[actionMap _ self createActionMap.
		self setProperty: #actionMap toValue: actionMap].
	^ actionMap! !

OldMorphWithModel removeSelector: #removeAll!
OldMorph removeSelector: #outOfWorld:!
CompositeMorph removeSelector: #outOfWorld:!
Morph removeSelector: #outOfWorld:!

!MenuItemLW class reorganize!
('as yet unclassified')
!

!classDefinition: #MenuItemLW category: #'LightWidgets-Widgets'!
ButtonLW subclass: #MenuItemLW
	instanceVariableNames: 'foreColor backColor selectedForeColor selectedBackColor'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'LightWidgets-Widgets'!

!MenuItemLW reorganize!
('accessing' backColor backColor: foreColor foreColor: selectedBackColor: selectedForeColor:)
('initialization' initialize)
('drawing' drawHighlightOn: drawOn:)
('event handling' mouseUp:)
!

CompositeLW removeSelector: #outOfWorld:!
LightWidget removeSelector: #outOfWorld:!
