Aargh, I'm having internet problems; this is the third time writing 
this email.

On Thu, Jan 09, 2003 at 08:11:31PM +0100, Andreas Raab wrote:
> Josh,
> 
> Thanks - by now I got various copies from people (thanks to all of you!)

I think mine might be a teensy bit newer.

> but this is the kind of thing that really _ought_ to be on SqueakMap
> (hint, hint!).

Ok, I get the hint :-)

> 
> > What are you thinking of doing with it?
> 
> I'm looking into different ways of end-user friendly specification of
> "object compositions" (aka: layouts). Since I know that Cassowary was
> used for CSVG and other things I was wondering if it might be a good
> starting base for some more end-user friendly model than we have right
> now.
> 
> This problem bugged me for a long time now - the AlignmentMorph's in
> Squeak used to require compositions of compositions of compositions of
> nested things and they just got in the way of "seeing the thing you are
> interested in" (namely some object of the composition). So I tried to
> generalize this into the layouts we have today but while they are more
> general they are also much harder to understand (lots of very generic
> properties with lots of unclear compositional effects).
> 
> So what I am essentially looking for is some way of specifying "lots of
> dog-simple constraints" (like: make the left edge of one guy follow the
> right edge of some other guy) and provide some interactive means for
> specifying it - so that rather than having a set of generic properties
> the user gets a (possibly large) number of very concrete
> mini-constraints. Those need to be solved efficiently and that's when I
> got into thinking about the various constraint solvers.
> 
> BTW, do you know if Cassowary can give feedback about constraints that
> cannot be resolved (perhaps even potentially)?! I'm interested in this
> because what I would like to do is give constant feedback about the
> composition you are building - so that when you add a constraint which
> "won't work" the system could indicate this by some means.

An exception is thrown when a required constraint cannot be met.
Non-required constraints that cannot be met show up as a penalty
in the objective function.

I'm also attaching my Morphowary changesets, which constitute a
preliminary attempt at integrating Cassowary into Morphic.  My
approach has a serious flaw that impacts performance.  Each world
cycle, constrained morphs that have had their bounds changed add an
'edit variable' to Cassowary, and remove it after the cycle is
finished.  Unfortunately, adding/removing these variables is slow; it
would be better to use the same edit variables throughout a drag,
resize, etc. operation.  My approach was simpler to implement, and
I didn't realize the performance implications until later.

Note that the MorphBoundsRefactoring changeset touches a lot of
Morphic classes, and works best in a 3.2-4599 image.  This was the
second time that I did this refactoring, and it again failed to 
make it into the image.  I don't have time now, but when I do, I'm
willing to bring it up to date again if it will be included in the
image.

Hope this helps,
Joshua

> 
> Cheers,
>   - Andreas
> 
> > -----Original Message-----
> > From: squeak-dev-admin at lists.squeakfoundation.org 
> > [mailto:squeak-dev-admin at lists.squeakfoundation.org] On 
> > Behalf Of Joshua 'Schwa' Gargus
> > Sent: Thursday, January 09, 2003 7:32 PM
> > To: Andreas Raab; Squeak Mailing List
> > Subject: Re: Cassowary anyone?!
> > 
> > 
> > Hi Andreas,
> > 
> > My message to the list seems to have been lost, so I'm resending
> > to you and the list.
> > 
> > You can get Cassowary from:
> > http://www.cc.gatech.edu/~schwa/squeak/packages/
> > 
> > What are you thinking of doing with it?
> > Joshua
> > 
> 
-------------- next part --------------
'From Squeak3.2alpha of 3 October 2001 [latest update: #4599] on 8 January 2002 at 10:46:50 am'!
"Change Set:		Morphowary (initial Squeak list release)
Date:			1 January 2002
Author:			Joshua Gargus

First cut at integrating Cassowary (a linear constraint solver for UIs) with Morphic.  This changeset is dependent on Cassowary and MorphBoundsRefactoring, and has been 'tested' under Squeak 3.2-4599.

Currently, the only morph property that can be constrained is its bounds (actually, its position and extent).  However, others could easily be added.

There is no UI for creating constraints, although both the World menu and morphs' red halo menus have a menu item, 'view constraints...', which brings up a minimal UI for enabling/disabling/deleting constraints.  The 
methods SolverLiason>>demo1 and demo2 show how to generate constraints procedurally.

The core classes are found in Morphowary-Solver, and Morphowary-Morphs contain the code for the rudimentary UI.  Morphowary-Tests is!
 woefully behind the rest of the system.

TO DO (clearly not exhaustive):
-------------------------------------
-Performance optimization: there is currently a big speed hit for adding/removing edit vars each cycle.

"!

Object subclass: #Constrainer
	instanceVariableNames: 'morph position extent constraints '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphowary-Solver'!

!Constrainer commentStamp: '<historical>' prior: 0!
I act as a liason between a morph and the constraint solver for the World that the morph is in.
I am held by the MorphExtension, and contain all of the ClVariables for the attributes of the constrained morph.

I also act as an observer that is notified whenever a property of interest (eg: my morph's position or extent) is changed.

Finally, I hold onto all of the constraints that have been defined on this morph.  These are stored in the 'defaultConstraints' Dictionary.  The keys are the solvers that constraints belong to, and the values are!
 collections of constraints.

morph				-	The Morph that is being constrained.
position				-	A Point containing ClVariables.
extent				-	A Point containing ClVariables.
defaultConstraints	-	Constraints that should hold for all solvers (eg: stays on position/extent).
userConstraints		-	Dictionary whose keys are solvers and whose values are collections of
						constraints.  Allows switching of which solver is active.

!

Object subclass: #Constraint
	instanceVariableNames: 'constraints description constraintType solvers constrainers '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphowary-Solver'!

!Constraint commentStamp: '<historical>' prior: 0!
I represent one or more constraints that logically belong together (ie: achieve a single desired behavior).  An example would be a group of constraints that cause a morph to remain within the bounds of another morph.

My constraints are of the types internally used by Cassowary and/or other constraint solvers.  SolverL!
iasons that I am added to are responsible for making sure that my constraints are solved by the most appropriate solver.

constraints		-	constraints to be maintained by various solvers
description		-	purpose of this constraint; used by UIs
constraintType	-	who created this constraint; used by UIs
solvers			-	constraint solvers 
constrainers		-	cache to speed up #constrainers!

Object subclass: #DebugBoundsWatcher
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphowary-Tests'!
BorderedMorph subclass: #ConstraintViewerMorph
	instanceVariableNames: 'liason constraint description status '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphowary-Morphs'!

!ConstraintViewerMorph commentStamp: 'jcg 1/6/2002 23:46' prior: 0!
I provide a view of a single constraint.  See class comment of MultipleConstraintMorph.!

TestCase subclass: #MorphowaryTestCase
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	categor!
y: 'Morphowary-Tests'!
ClVariable subclass: #MorphowaryVariable
	instanceVariableNames: 'constrainer '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphowary-Solver'!

!MorphowaryVariable commentStamp: 'jcg 1/2/2002 22:09' prior: 0!
I am a ClVariable that keeps track of what constrainer I belong to.  This allows ordinary Cassowary constraints to be queries as to which constrainers they involve.!

BorderedMorph subclass: #MultipleConstraintMorph
	instanceVariableNames: 'constraintSource constraints constraintHolder showDefaultConstraints '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphowary-Morphs'!

!MultipleConstraintMorph commentStamp: 'jcg 1/6/2002 23:46' prior: 0!
A simple UI doohickey that displays the constraints of the viewed entity, which can be either
a Constrainer associated with a particular morph, or a SolverLiason associated with an entire world.  The color of each constraint's morph represents its status (see 'visual properties' c!
ategory of ConstraintViewerMorph).  Each constraint can be clicked to bring up a menu, allowing changes of constraint status as well as inspection of related information.!

Object subclass: #SolverLiason
	instanceVariableNames: 'solver watching activated activeConstraints passiveConstraints editConstrainers '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphowary-Solver'!

!SolverLiason commentStamp: 'jcg 1/2/2002 22:00' prior: 0!
I am one of two loci (the other being Constrainer) for communication between the morphic world and a constraint solver.  I currently assume that the solver is Cassowary, but am intended to eventually be independent of the actual solver used, even allowing solvers of different types to simultaneously constrain the world.  In this case, I would probably be split into two classes.  See SolverLiason>>solveConstraints.

I control whether or not any constraints are enforced in a particular world, and keep track of whether individual constra!
ints are active or passive.

Each update cycle, desired changes to constrained values are fed into the solver, and morphs in the world are updated to reflect the solver's best attempt to allow these values without violating constraints.  See WorldState>>doOneCycleNowFor:.  

It has fallen upon me to also do dirty work like providing demos and other utilities (see class side).

SolverLiason demo1.
SolverLiason demo2.


solver				-	the actual constraint solver (only one at a time for now).
watching			-	boolean; am I currently paying attention to changes in morph bounds?
activated			-	boolean; am I enforcing constraints in my world?
activeConstraints	-	constraints that will be enforced if I am activated.
passiveConstraints	-	constraints that are not enforced, but that UI should be able to show.
editConstrainers		-	constrainers which suggest a new value that the solver will try to allow.




!

Object subclass: #WorldState
	instanceVariableNames: 'hands activeHand viewBox canvas!
 damageRecorder stepList lastStepTime lastStepMessage lastCycleTime commandHistory alarms lastAlarmTime remoteServer multiCanvas liason '
	classVariableNames: 'CanSurrenderToOS DeferredUIMessages DisableDeferredUpdates LastCycleTime MinCycleLapse '
	poolDictionaries: ''
	category: 'Morphic-Worlds'!

!ClConstraint methodsFor: 'morphowary' stamp: 'jcg 8/20/2001 12:03'!
constrainers
	| set |

	set _ IdentitySet new.
	self variables do: [:var |
		(var isKindOf: MorphowaryVariable) ifTrue: [set add: var constrainer]].
	^ set asOrderedCollection
! !

!ClConstraint methodsFor: 'morphowary' stamp: 'jcg 8/20/2001 12:03'!
involvesConstrainer: aConstrainer

	^ self constrainers includes: aConstrainer
! !

!ClConstraint methodsFor: 'morphowary' stamp: 'jcg 7/27/2001 13:56'!
involvesVariable: aVariable

	^ self variables includes: aVariable
! !

!ClConstraint methodsFor: 'morphowary' stamp: 'jcg 7/27/2001 13:54'!
variables

	^ #()! !


!ClEditOrStayConstraint methodsFor: 'morphowary' sta!
mp: 'jcg 7/27/2001 13:57'!
variables

	^ OrderedCollection with: variable! !


!ClLinearConstraint methodsFor: 'morphowary' stamp: 'jcg 7/26/2001 13:08'!
variables
	| set |
	
	set _ IdentitySet new.
	expression variablesAndCoefficientsDo: [:v :c | set add: v].
	^ set asOrderedCollection

	! !


!ClLinearExpression methodsFor: 'manipulation' stamp: 'jcg 7/7/2001 07:59'!
@ y
	"Answer a Point containing myself and 'y'."

	^ Point x: self y: y
! !

!ClLinearExpression methodsFor: 'manipulation' stamp: 'jcg 8/10/2001 19:28'!
negated

	^ self * -1! !


!ClSimplexSolver methodsFor: 'morphowary' stamp: 'jcg 8/20/2001 13:05'!
removeEmptyColumns
	"Prevent solver from hanging onto variables it doesn't need."

	{columns} do: [:dict |
		dict keysDo: [:key | (dict at: key) isEmpty ifTrue: [dict removeKey: key]]]! !


!Constrainer methodsFor: 'accessing' stamp: 'jcg 1/2/2002 21:29'!
constraints
	"Answer all constraints which involve any of my variables."

	^ constraints copy! !

!Constrain!
er methodsFor: 'accessing' stamp: 'jcg 1/2/2002 21:31'!
defaultConstraints
	"Answer the constraints that my morph has by default."

	^ constraints select: [:con | con isDefaultConstraint]
! !

!Constrainer methodsFor: 'accessing' stamp: 'jcg 1/3/2002 13:27'!
isLiason

	^ false! !

!Constrainer methodsFor: 'accessing' stamp: 'jcg 1/2/2002 21:27'!
liason
	"Answer the constraint solver liason associated with the world that my morph is currently in."

	morph ifNil: [^ nil].
	^ morph world ifNotNilDo: [:world | world liason]! !

!Constrainer methodsFor: 'accessing' stamp: 'jcg 1/2/2002 21:28'!
morph
	"Answer the morph whose properties I am constraining."

	^ morph! !

!Constrainer methodsFor: 'accessing' stamp: 'jcg 1/2/2002 21:34'!
systemConstraints
	"Answer all system-created constraints that involve any of my variables.  For example, a constraint might be added to try to follow the mouse pointer; it will do so unless other constraints do not allow this to occur."

	^ constrain!
ts select: [:con | con isSystemConstraint]
! !

!Constrainer methodsFor: 'accessing' stamp: 'jcg 1/2/2002 21:34'!
userConstraints
	"Answer all user-created constraints that involve any of my variables."

	^ constraints select: [:con | con isUserConstraint]
! !

!Constrainer methodsFor: 'accessing-geometry' stamp: 'jcg 1/2/2002 22:50'!
bottom
	"Answer a variable or expression that can be used by the constraint solver."

	^ self top + self height
! !

!Constrainer methodsFor: 'accessing-geometry' stamp: 'jcg 1/2/2002 22:50'!
bottomLeft
	"Answer a variable or expression that can be used by the constraint solver."

	^ position + (0 at self height)! !

!Constrainer methodsFor: 'accessing-geometry' stamp: 'jcg 1/2/2002 22:50'!
bottomRight
	"Answer a variable or expression that can be used by the constraint solver."
	
	^ self position + self extent
! !

!Constrainer methodsFor: 'accessing-geometry' stamp: 'jcg 1/2/2002 22:50'!
center
	"Answer a variable or expression that can be used !
by the constraint solver."

	^ position + (extent * 0.5)
! !

!Constrainer methodsFor: 'accessing-geometry' stamp: 'jcg 1/2/2002 22:51'!
extent
	"Answer a variable or expression that can be used by the constraint solver."

	^ extent! !

!Constrainer methodsFor: 'accessing-geometry' stamp: 'jcg 1/2/2002 22:51'!
height
	"Answer a variable or expression that can be used by the constraint solver."

	^ extent y! !

!Constrainer methodsFor: 'accessing-geometry' stamp: 'jcg 1/2/2002 22:51'!
left
	"Answer a variable or expression that can be used by the constraint solver."

	^ position x
! !

!Constrainer methodsFor: 'accessing-geometry' stamp: 'jcg 1/2/2002 22:51'!
position
	"Answer a variable or expression that can be used by the constraint solver."

	^ position! !

!Constrainer methodsFor: 'accessing-geometry' stamp: 'jcg 1/2/2002 22:51'!
right
	"Answer a variable or expression that can be used by the constraint solver."

	^ self left + self width
! !

!Constrainer methodsFor: 'a!
ccessing-geometry' stamp: 'jcg 1/2/2002 22:51'!
top
	"Answer a variable or expression that can be used by the constraint solver."

	^ position y! !

!Constrainer methodsFor: 'accessing-geometry' stamp: 'jcg 1/2/2002 22:52'!
topLeft
	"Answer a variable or expression that can be used by the constraint solver."

	^ position! !

!Constrainer methodsFor: 'accessing-geometry' stamp: 'jcg 1/2/2002 22:52'!
topRight
	"Answer a variable or expression that can be used by the constraint solver."

	^ position + (self width at 0)! !

!Constrainer methodsFor: 'accessing-geometry' stamp: 'jcg 1/2/2002 22:52'!
width
	"Answer a variable or expression that can be used by the constraint solver."

	^ extent x! !

!Constrainer methodsFor: 'constraint interaction' stamp: 'jcg 1/2/2002 21:25'!
becomeInvolvedIn: aConstraint
	"aConstraint now involves one or more of my variables; note this."

	constraints add: aConstraint
	! !

!Constrainer methodsFor: 'constraint interaction' stamp: 'jcg 1/2/2002 21:26!
'!
becomeUninvolvedIn: aConstraint
	"aConstraint no longer involves any of my variables (currently, this only happens when it is being destroyed).  Update accordingly."

	constraints remove: aConstraint ifAbsent: [].
	constraints isEmpty ifTrue: [self becomeUnconstrained]
	! !

!Constrainer methodsFor: 'debugging' stamp: 'jcg 8/20/2001 00:32'!
clearMorph

	morph _ nil! !

!Constrainer methodsFor: 'initialization and finalization' stamp: 'jcg 1/2/2002 13:44'!
addDefaultConstraints
	"Set up initial constraints.  Morphs prefer being moved to changing their size."
	| defaults |

	defaults _ Constraint newDefaultConstraint.
	defaults 
		addAllConstraints: {
			ClStayConstraint variable: position x strength: ClStrength weak.
			ClStayConstraint variable: position y strength: ClStrength weak.
			ClStayConstraint variable: extent x strength: ClStrength weak weight: 5.
			ClStayConstraint variable: extent y strength: ClStrength weak weight: 5.
			extent x cnGEQ: 0.
			extent y cnGEQ:!
 0};
		description: 'default'.

	morph world ifNotNilDo: [:world | world assuredLiason addConstraintImmediately: defaults]
! !

!Constrainer methodsFor: 'initialization and finalization' stamp: 'jcg 8/29/2001 10:05'!
becomeUnconstrained
	"Interacts closely with Morph>>becomeUnconstrained.  If either one is called, the effect will be the same."

	"If we have been invoked from Morph>>becomeUnconstrained, this will return without doing anything."
	morph isConstrained ifTrue: [^ morph becomeUnconstrained].

	constraints copy do: [:constraint | constraint destroy].
	[constraints isEmpty] assert
! !

!Constrainer methodsFor: 'initialization and finalization' stamp: 'jcg 1/2/2002 22:53'!
initializeFor: aMorph
	"Create variables from current properties of aMorph, and set default constraints on them."
	| x y width height |

	morph _ aMorph.
	constraints _ Set new.

	"Initialize position and extent."
	x _ MorphowaryVariable 
			newWith: aMorph left 
			name: #x
			constrainer: self.
	!
y _ MorphowaryVariable 
			newWith: aMorph top 
			name: #y
			constrainer: self.
	position _ x at y.
	width _ MorphowaryVariable 
			newWith: aMorph width 
			name: #width
			constrainer: self.
	height _ MorphowaryVariable 
			newWith: aMorph height 
			name: #height
			constrainer: self.
	extent _ width at height.

	self addDefaultConstraints
! !

!Constrainer methodsFor: 'printing' stamp: 'jcg 7/7/2001 08:07'!
printOn: aStream

	super printOn: aStream.
	aStream nextPut: $(.
	morph printOn: aStream.
	aStream nextPut: $).! !

!Constrainer methodsFor: 'solver interaction' stamp: 'jcg 1/2/2002 19:13'!
editedValues
	"Answer a collection of values corresponding to the variables from #editedVariables."
	
	^ { morph left. morph top. morph width. morph height }
! !

!Constrainer methodsFor: 'solver interaction' stamp: 'jcg 1/2/2002 19:12'!
editedVariables
	"Answer a collection of edited variables."
	
	^ { position x. position y. extent x. extent y }
! !

!Constrainer methodsFor: 'solver!
 interaction' stamp: 'jcg 1/2/2002 22:54'!
updateMorphValues
	"The values of my variables have just been set by the constraint solver.  Update the corresponding properties of the morph with the (possibly) new values."
	| bounds |

	morph ifNil: [^ self].

	bounds _ position valuePoint extent: extent valuePoint.
	morph bounds: bounds.

! !

!Constrainer methodsFor: 'watching' stamp: 'jcg 1/2/2002 16:50'!
boundsOf: aMorph changingTo: newBounds
	"aMorph is about to have its bounds changed.  If the World is constrained, inform the solver liason."
	| world |

	world _ aMorph world ifNil: [^ self].
	world hasLiason ifTrue: [world liason addEditConstrainer: self]
! !


!Constrainer class methodsFor: 'instance creation' stamp: 'jcg 7/6/2001 12:10'!
forMorph: aMorph

	^ super new initializeFor: aMorph! !


!Constraint methodsFor: 'accessing' stamp: 'jcg 1/2/2002 14:22'!
constrainedMorphs
	"Answer the morphs whose constrainers have variables mentioned in my constraints."

	^ self cons!
trainers collect: [:c | c morph]
! !

!Constraint methodsFor: 'accessing' stamp: 'jcg 1/2/2002 10:06'!
constrainers
	"Answer all Constrainers having variables mentioned in my constraints."

	constrainers isNil ifTrue: [
		constrainers _ self variables 
							select: [:var | var isKindOf: MorphowaryVariable] 
							thenCollect: [:var | var constrainer]].
	^ constrainers! !

!Constraint methodsFor: 'accessing' stamp: 'jcg 1/3/2002 12:50'!
description
	"Answer a String that describes the purpose of this constraint; used for UI viewing."

	^ description ifNil: ['<no description>']! !

!Constraint methodsFor: 'accessing' stamp: 'jcg 1/3/2002 11:50'!
description: aStringOrNil
	"Set a description of the constraint for use in UIs."

	description _ aStringOrNil! !

!Constraint methodsFor: 'accessing' stamp: 'jcg 1/3/2002 11:55'!
rawConstraints
	"Answer all of the raw constraints (those of types recognized by the actual constraint solvers) that make up this Constraint."

	^ constrai!
nts! !

!Constraint methodsFor: 'accessing' stamp: 'jcg 1/3/2002 11:53'!
subConstraints
	"Answer all of the subConstraints that make up this Constraint.  The subConstraints are of types that are known by the actual constraint solvers (eg: Cassowary)."

	^ constraints! !

!Constraint methodsFor: 'accessing' stamp: 'jcg 1/3/2002 11:52'!
variables
	"Answer all of the variables involved in this constraint."
	| variables |

	variables _ IdentitySet new.
	constraints do: [:con | variables addAll: con variables].
	^ variables! !

!Constraint methodsFor: 'initialization' stamp: 'jcg 1/3/2002 11:57'!
addAllConstraints: collectionOfConstraints
	"Find all of the constrainers in collectionOfConstraints that do not appear in the constraints we already have, and notify them that a new constraint now involves them.  Note that the added constraints should be raw constraints (ie: those expected by the actual constraint solvers)."
	| newConstrainers currentConstrainers |
	
	newConstrainers _ !
Set new.
	currentConstrainers _ self constrainers.

	collectionOfConstraints do: [:constraint | 
		newConstrainers addAll: (constraint constrainers difference: currentConstrainers)].
	constraints addAll: collectionOfConstraints.
	newConstrainers do: [:con | con becomeInvolvedIn: self].

	self clearConstrainerCache! !

!Constraint methodsFor: 'initialization' stamp: 'jcg 1/2/2002 01:20'!
addConstraint: aConstraint

	self addAllConstraints: {aConstraint}.
! !

!Constraint methodsFor: 'initialization' stamp: 'jcg 1/3/2002 11:59'!
constraintType: aSymbol
	"In future, will used by UI to determine how/if constraint is to be displayed."

	constraintType _ aSymbol! !

!Constraint methodsFor: 'initialization' stamp: 'jcg 1/3/2002 12:00'!
initialize
	"By default, constraints are assumed to be created at the command of the user."

	constraints _ OrderedCollection new.
	constraintType _ #user.
	solvers _ Set new.! !

!Constraint methodsFor: 'printing' stamp: 'jcg 1/2/2002 14:26'!
printO!
n: aStream

	super printOn: aStream.
	description ifNotNil: [
		aStream nextPut: $(.
		aStream nextPutAll: description.
		aStream nextPut: $)]! !

!Constraint methodsFor: 'solver interaction' stamp: 'jcg 1/2/2002 21:25'!
destroy

	self removeFromAllSolvers.
	self constrainers do: [:constrainer | constrainer becomeUninvolvedIn: self]
! !

!Constraint methodsFor: 'solver interaction' stamp: 'jcg 1/3/2002 12:02'!
noteAdditionTo: aSolverLiason
	"Keep track of the worlds (via the liason) this constraint is known in."

	solvers add: aSolverLiason! !

!Constraint methodsFor: 'solver interaction' stamp: 'jcg 1/3/2002 12:02'!
noteRemovalFrom: aSolverLiason
	"Keep track of the worlds (via the liason) this constraint is known in."

	solvers 
		remove: aSolverLiason
		ifAbsent: [self error: 'noting removal from liason that we never noted addition to']! !

!Constraint methodsFor: 'solver interaction' stamp: 'jcg 1/3/2002 12:03'!
removeFromAllSolvers
	"Tell all solvers to remove me from t!
hem; this will result in me being sent #noteRemovalFrom:"

	solvers do: [:solver | solver removeConstraint: self]! !

!Constraint methodsFor: 'testing' stamp: 'jcg 1/2/2002 14:23'!
constrainedMorphsAllInWorld: aWorld
	"Answer true if all of my constrained morphs are currently submorphs of aWorld."

	^ self constrainedMorphs allSatisfy: [:m | m world = aWorld] 
! !

!Constraint methodsFor: 'testing' stamp: 'jcg 1/2/2002 14:24'!
involvesConstrainer: aConstrainer

	^ self constrainers includes: aConstrainer
! !

!Constraint methodsFor: 'testing' stamp: 'jcg 1/2/2002 14:25'!
involvesVariable: aVariable

	^ self variables includes: aVariable
! !

!Constraint methodsFor: 'testing' stamp: 'jcg 1/2/2002 14:25'!
isDefaultConstraint

	^ constraintType == #default! !

!Constraint methodsFor: 'testing' stamp: 'jcg 1/2/2002 14:25'!
isSystemConstraint

	^ constraintType == #system! !

!Constraint methodsFor: 'testing' stamp: 'jcg 1/2/2002 14:25'!
isUserConstraint

	^ constraintType == #us!
er! !

!Constraint methodsFor: 'private' stamp: 'jcg 1/2/2002 10:15'!
clearConstrainerCache

	constrainers _ nil! !


!Constraint class methodsFor: 'instance creation' stamp: 'jcg 1/3/2002 11:59'!
new

	^ super new initialize! !

!Constraint class methodsFor: 'instance creation' stamp: 'jcg 1/3/2002 11:59'!
newDefaultConstraint
	"In future, will used by UI to determine how/if constraint is to be displayed."

	^ self new constraintType: #default
! !

!Constraint class methodsFor: 'instance creation' stamp: 'jcg 1/3/2002 11:59'!
newSystemConstraint
	"In future, will used by UI to determine how/if constraint is to be displayed."

	^ self new constraintType: #system
! !


!DebugBoundsWatcher methodsFor: 'as yet unclassified' stamp: 'jcg 8/10/2001 17:38'!
boundsOf: aMorph changingTo: newBounds

	Transcript show: aMorph printString, '  ', newBounds printString; cr! !


!Morph methodsFor: 'debug and other' stamp: 'sw 8/4/2001 00:54'!
buildDebugMenu: aHand
	"Answer a debugging menu !
for the receiver.  The hand argument is seemingly historical and plays no role presently"

	| aMenu aPlayer |
	aMenu _ MenuMorph new defaultTarget: self.
	aMenu addStayUpItem.
	(self hasProperty: #errorOnDraw) ifTrue:
		[aMenu add: 'start drawing again' action: #resumeAfterDrawError.
		aMenu addLine].
	(self hasProperty: #errorOnStep) ifTrue:
		[aMenu add: 'start stepping again' action: #resumeAfterStepError.
		aMenu addLine].

	aMenu add: 'inspect morph' action: #inspectInMorphic:.
	aMenu add: 'inspect owner chain' action: #inspectOwnerChain.
	Smalltalk isMorphic ifFalse:
		[aMenu add: 'inspect morph (in MVC)' action: #inspect].

	(self isKindOf: MorphicModel) ifTrue:
		[aMenu add: 'inspect model' target: self model action: #inspect].
	(aPlayer _ self player) ifNotNil:
		[aMenu add: 'inspect player' target: aPlayer action: #inspect].

     aMenu add: 'explore morph' target: self selector: #explore.

	aPlayer ifNotNil:
		[aPlayer class isUniClass ifTrue: [aMenu add: 'browse !
player class' target: aPlayer action: #browseHierarchy].
		"aMenu add: 'browse player protocol' target: self action: #browseProtocolForPlayer"].

	aMenu addLine.
	aMenu add: 'viewer for Player' target: self player action: #beViewed.
	aMenu balloonTextForLastItem: 'Opens a viewer on my Player -- this is the same thing you get if you click on the cyan "View" halo handle'.
	aMenu add: 'viewer for Morph' target: self action: #viewMorphDirectly.
	aMenu balloonTextForLastItem: 'Opens a Viewer on this Morph, rather than on its Player'.
	aMenu addLine.

	aMenu add: 'browse morph class' target: self selector: #browseHierarchy.
	aMenu addLine.
	aMenu add: 'morph protocol (text)' target: self selector: #haveFullProtocolBrowsed.
	aMenu add: 'morph protocol (tiles)' target: self selector: #openInstanceBrowserWithTiles.
	aMenu addLine.
	self addViewingItemsTo: aMenu.
	aMenu 
		add: 'make own subclass' action: #subclassMorph;
		add: 'internal name ' action: #choosePartName;
		add: 'save mo!
rph in file'  action: #saveOnFile;
		addLine;
		add: 'call #tempCommand' action: #tempCommand;
		add: 'define #tempCommand' action: #defineTempCommand;
		addLine;

		add: 'control-menu...' target: self selector: #invokeMetaMenu:;
		add: 'edit balloon help' action: #editBalloonHelpText.

	^ aMenu! !

!Morph methodsFor: 'menus' stamp: 'jcg 1/6/2002 17:01'!
addStandardHaloMenuItemsTo: aMenu hand: aHandMorph
	"Add standard halo items to the menu"

	| unlockables |

	self isWorldMorph ifTrue:
		[^ self addWorldHaloMenuItemsTo: aMenu hand: aHandMorph].

	self mustBeBackmost ifFalse:
		[aMenu add: 'send to back' action: #goBehind.
		aMenu add: 'bring to front' action: #comeToFront.
		self potentialEmbeddingTargets size > 1 ifTrue:
			[aMenu add: 'embed...' target: self action: #embedInto:].
		aMenu addLine].

	self addFillStyleMenuItems: aMenu hand: aHandMorph.
	self addBorderStyleMenuItems: aMenu hand: aHandMorph.
	self addDropShadowMenuItems: aMenu hand: aHandMorph.
	self addLayo!
utMenuItems: aMenu hand: aHandMorph.
	self addHaloActionsTo: aMenu.
	aMenu addLine.
	self addToggleItemsToHaloMenu: aMenu.
	aMenu addLine.
	self addCopyItemsTo: aMenu.
	self addPlayerItemsTo: aMenu.
	self addExportMenuItems: aMenu hand: aHandMorph.
	self addStackItemsTo: aMenu.
	self adMiscExtrasTo: aMenu.
	Preferences noviceMode ifFalse:
		[self addDebuggingItemsTo: aMenu hand: aHandMorph].

	aMenu addLine.
	aMenu defaultTarget: self.

	"View constraints for this Morph."
	self isConstrained ifTrue: [
		aMenu add: 'view constraints...' action: #displayConstraints].

	aMenu addLine.

	unlockables _ self submorphs select:
		[:m | m isLocked].
	unlockables size == 1 ifTrue:
		[aMenu add: 'unlock "', unlockables first externalName, '"' action: #unlockContents].
	unlockables size > 1 ifTrue:
		[aMenu add: 'unlock all contents' action: #unlockContents.
		aMenu add: 'unlock...' action: #unlockOneSubpart].

	aMenu defaultTarget: aHandMorph.
! !

!Morph methodsFor: 'menus' stamp: 'jc!
g 1/6/2002 17:03'!
displayConstraints

	self isConstrained ifTrue: [
		(MultipleConstraintMorph newWithConstraintSource: self constrainer) openInHand]! !

!Morph methodsFor: 'morphowary' stamp: 'jcg 1/2/2002 00:55'!
assuredConstrainer
	"Answer our constrainer, creating a new one if necessary."
	| constrainer |

	^ self valueOfProperty: #constrainer ifAbsentPut: [
		constrainer _ Constrainer forMorph: self.
		self addBoundsWatcher: constrainer.
		constrainer]! !

!Morph methodsFor: 'morphowary' stamp: 'jcg 8/10/2001 11:00'!
becomeUnconstrained
	"Interacts closely with Constrainer>>becomeUnconstrained.  If either one is called, the effect will be the same."

	self valueOfProperty: #constrainer ifPresentDo: [:constrainer |
		self 
			removeBoundsWatcher: constrainer;
			removeProperty: #constrainer.
		constrainer becomeUnconstrained]
! !

!Morph methodsFor: 'morphowary' stamp: 'jcg 1/2/2002 00:58'!
constrainer
	"Answer my constrainer, or nil if I do not have one."

	^ self valu!
eOfProperty: #constrainer ifAbsent: [nil]! !

!Morph methodsFor: 'morphowary' stamp: 'jcg 7/26/2001 15:16'!
isConstrained

	^ self hasProperty: #constrainer! !

!Morph methodsFor: 'structure' stamp: 'jcg 7/5/2001 10:11'!
privateBounds: boundsRect
	"Private!! Use position: and/or extent: instead."

	"jcg: answer the new bounds so that the method acts as much as possible like a store into the variable.  For example: 'dummyRect _ (self privateBounds: newRect)' should work."

	(self hasBoundsWatchers and: [bounds ~= boundsRect]) ifTrue: [
		self boundsWatchers do: [:watcher | watcher boundsOf: self changingTo: boundsRect]].

	fullBounds _ nil.
	bounds _ boundsRect.

	^ bounds! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'jcg 8/10/2001 11:04'!
abandon
	"Like delete, but we really intend not to use this morph again.  Clean up a few things."

	self becomeUnconstrained; delete! !

!Morph methodsFor: 'watching' stamp: 'jcg 7/4/2001 15:41'!
addBoundsWatcher: aBoundsWatcher
	| !
watchers |

	watchers _ self valueOfProperty: #boundsWatchers ifAbsentPut: [IdentitySet new].
	watchers add: aBoundsWatcher! !

!Morph methodsFor: 'watching' stamp: 'jcg 7/4/2001 15:43'!
boundsWatchers

	^ self valueOfProperty: #boundsWatchers ifAbsent: [#()]! !

!Morph methodsFor: 'watching' stamp: 'jcg 7/5/2001 10:03'!
hasBoundsWatchers

	^ self boundsWatchers isEmpty not! !

!Morph methodsFor: 'watching' stamp: 'jcg 7/4/2001 15:47'!
removeBoundsWatcher: aBoundsWatcher
	| watchers |

	watchers _ self valueOfProperty: #boundsWatchers ifAbsent: [^ self].
	watchers remove: aBoundsWatcher ifAbsent: [].
	watchers isEmpty ifTrue: [self removeProperty: #boundsWatchers]! !


!ConstraintViewerMorph methodsFor: 'initialization' stamp: 'jcg 1/3/2002 13:18'!
constraint: aConstraint liason: aSolverLiason

	constraint _ aConstraint.
	liason _ aSolverLiason.

	description _ StringMorph contents: aConstraint description.
	
	self addMorph: description! !

!ConstraintViewerMorph methodsFor:!
 'initialization' stamp: 'jcg 1/6/2002 15:33'!
initialize

	super initialize.
	self 
		color: (Color white alpha: 0.4);
		borderWidth: 0;
		changeTableLayout;
		layoutInset: 5 at 1;
		vResizing: #shrinkWrap;
		hResizing: #spaceFill;
		on: #mouseDown send: #popUpMenu to: self! !

!ConstraintViewerMorph methodsFor: 'accessing' stamp: 'jcg 1/8/2002 02:59'!
constraint
	"Answer the constraint viewed by this morph."

	^ constraint! !

!ConstraintViewerMorph methodsFor: 'accessing' stamp: 'jcg 1/8/2002 03:00'!
status
	"Answer a symbol indicating the status of the constraint."

	^ status! !

!ConstraintViewerMorph methodsFor: 'menu' stamp: 'jcg 1/8/2002 03:01'!
flashConstrainedMorphs
	"Flash all morphs involved in my constraint, so that they can be seen."

	constraint constrainedMorphs do: [:m | m flash. (Delay forMilliseconds: 100) wait].
! !

!ConstraintViewerMorph methodsFor: 'menu' stamp: 'jcg 1/8/2002 03:02'!
popUpMenu
	"Menu of operations and queries for my constraint."
	| menu w!
orld |

	menu _ MenuMorph new defaultTarget: self.
	
	self status == #active ifTrue: [
		menu
			addTitle: 'constraint options (active)';
			add: 'deactivate constraint' target: liason selector: #deactivateConstraint: argument: constraint;
			add: 'remove from liason' target: liason selector: #removeConstraint: argument: constraint;
			add: 'destroy constraint' target: constraint selector: #destroy].

	self status == #passive ifTrue: [
		menu addTitle: 'constraint options (passive)'.
		(liason canActivateConstraint: constraint) ifTrue: [
			menu add: 'activate constraint' target: liason selector: #activateConstraint: argument: constraint].
		menu 
			add: 'remove from liason' target: liason selector: #removeConstraint: argument: constraint;
			add: 'destroy constraint' target: constraint selector: #destroy].

	self status == #unknownToLiason ifTrue: [
		menu 
			addTitle: 'constraint options (unknown to liason)';
			add: 'add to liason' target: liason selector: #addConstrain!
t: argument: constraint;
			add: 'destroy constraint' target: constraint selector: #destroy].

	self status == #noLiason ifTrue: [
		menu addTitle: 'constraint options (no liason)'.
		world _ constraint constrainedMorphs anyOne world.
		world ifNotNil: [
			menu add: 'add to liason' target: world assuredLiason selector: #addConstraint: argument: constraint.
			liason _ world assuredLiason]].
	
	menu	
		addLine;
		add: 'flash constrained morphs' target: self selector: #flashConstrainedMorphs;
		addLine;
		add: 'inspect constraint' target: constraint selector: #inspect;
		add: 'inspect liason' target: liason selector: #inspect;
		add: 'inspect constrainers' target: constraint constrainers asArray selector: #inspect;
		add: 'inspect constrained morphs' target: constraint constrainedMorphs asArray selector: #inspect.
	
	menu popUpEvent: self activeHand lastEvent in: self world! !

!ConstraintViewerMorph methodsFor: 'updating' stamp: 'jcg 1/8/2002 03:02'!
getStatus
	"Update the s!
tatus of my constraint with respect to my liason."

	liason ifNil: [^ #noLiason].
	(liason hasActiveConstraint: constraint) ifTrue: [^ #active].
	(liason hasPassiveConstraint: constraint) ifTrue: [^ #passive].
	^ #unknownToLiason
	! !

!ConstraintViewerMorph methodsFor: 'updating' stamp: 'jcg 1/8/2002 03:02'!
update
	"Update my appearance to reflect my constraint's status."

	status _ self getStatus.
	
	"Set color from status."
	status == #unknownToLiason ifTrue: [self color: self unknownColor].
	status == #active ifTrue: [self color: self activeColor].
	status == #passive ifTrue: [self color: self passiveColor].
	status == #noLiason ifTrue: [self color: self noLiasonColor].! !

!ConstraintViewerMorph methodsFor: 'visual properties' stamp: 'jcg 1/6/2002 15:32'!
activeColor
	"Answer the color used to display constraints that are active for the given liason."

	^ Color green muchLighter! !

!ConstraintViewerMorph methodsFor: 'visual properties' stamp: 'jcg 1/6/2002 15:33'!
noL!
iasonColor
	"Answer the color used to display constraints if there is no liason."

	^ Color lightGray! !

!ConstraintViewerMorph methodsFor: 'visual properties' stamp: 'jcg 1/6/2002 15:33'!
passiveColor
	"Answer the color used to display constraints that are passive for the given liason."

	^ Color yellow muchLighter! !

!ConstraintViewerMorph methodsFor: 'visual properties' stamp: 'jcg 1/6/2002 15:33'!
unknownColor
	"Answer the color used to display constraints that are not known by the given liason."

	^ Color red muchLighter! !


!ConstraintViewerMorph class methodsFor: 'instance creation' stamp: 'jcg 1/3/2002 12:47'!
forConstraint: aConstraint andLiason: aSolverLiason

	^ self new constraint: aConstraint liason: aSolverLiason! !


!MorphowaryTestCase methodsFor: 'Morph-BoundsWatcher' stamp: 'jcg 7/5/2001 09:41'!
testBoundsWatcher

	| el |
	el _ EllipseMorph new.
	self should: [el boundsWatchers isEmpty].
	el addBoundsWatcher: 3.
	self should: [el boundsWatchers asArray =!
 {3}].
	el addBoundsWatcher: 5.
	self should: [el boundsWatchers size == 2].
	el addBoundsWatcher: 5.
	self should: [el boundsWatchers size == 2].
	el removeBoundsWatcher: 5.! !


!MorphowaryVariable methodsFor: 'accessing' stamp: 'jcg 1/2/2002 22:09'!
constrainer
	"Answer the constrainer that I belong to."

	^ constrainer! !

!MorphowaryVariable methodsFor: 'initialization' stamp: 'jcg 1/2/2002 22:10'!
constrainer: aConstrainer
	"Set the constrainer that I belong to."

	constrainer _ aConstrainer! !


!MorphowaryVariable class methodsFor: 'instance creation' stamp: 'jcg 1/2/2002 22:12'!
newWith: anObject name: nameString constrainer: constrainer
	"Create a new variable with anObject as its initial value, named nameString, and belonging to constrainer."

	^ self new
		value: anObject;
		name: nameString;
		constrainer: constrainer;
		yourself! !


!MultipleConstraintMorph methodsFor: 'accessing' stamp: 'jcg 1/8/2002 02:57'!
liason
	"If the constraint source is a SolverLiason!
, answer it.  Otherwise, query it for its liason."

	constraintSource isLiason ifTrue: [^ constraintSource].
	^ constraintSource liason! !

!MultipleConstraintMorph methodsFor: 'accessing' stamp: 'jcg 1/8/2002 02:58'!
showDefaultConstraints
	"Answer true if default constraints should be shown in addition to user and system constraints."

	^ showDefaultConstraints ifNil: [false]! !

!MultipleConstraintMorph methodsFor: 'accessing' stamp: 'jcg 1/8/2002 02:58'!
showDefaultConstraints: aBool
	"Set whether default constraints should be shown, or only user and system constraints."

	showDefaultConstraints _ aBool! !

!MultipleConstraintMorph methodsFor: 'accessing' stamp: 'jcg 1/8/2002 02:58'!
toggleShowDefaultConstraints

	self showDefaultConstraints: self showDefaultConstraints not! !

!MultipleConstraintMorph methodsFor: 'initialization' stamp: 'jcg 1/6/2002 23:36'!
constraintSource: aConstrainerOrSolverLiason
	"Set the entity whose constraints are being viewed.  Can view eithe!
r a Constrainer associated with a particular morph, or a SolverLiason associated with the world."

	constraintSource _ aConstrainerOrSolverLiason.
	constraintSource isLiason ifFalse: [
		(self findA: StringMorph) contents: 'Constraints for ', constraintSource morph printString]! !

!MultipleConstraintMorph methodsFor: 'initialization' stamp: 'jcg 1/6/2002 17:14'!
initialize
	| checkBoxArea buttonArea unconstrainButton dismissButton |
	super initialize.
	constraints _ Dictionary new.
	constraintHolder _ BorderedMorph new color: Color transparent;
				 changeTableLayout;
				 vResizing: #shrinkWrap;
				 hResizing: #shrinkWrap;
				 borderWidth: 7;
				 setBorderStyle: #complexFramed.

	self 
		color: Color white;
		useRoundedCorners;
		changeTableLayout;
		layoutInset: 10;
		cellInset: 10;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.

	checkBoxArea _ Morph new
						color: Color transparent;
						changeTableLayout;
						layoutInset: 3;
						listDirection: #leftToRig!
ht;
						vResizing: #shrinkWrap;
						hResizing: #shrinkWrap.

	checkBoxArea 
		addMorph: 
			(StringMorph contents: '  show default constraints');
		addMorph:
			(UpdatingThreePhaseButtonMorph checkBox
					target: self;
					actionSelector: #toggleShowDefaultConstraints;
					getSelector: #showDefaultConstraints).

	buttonArea _ Morph new
						color: Color transparent;
						changeTableLayout;
						layoutInset: 3;
						cellInset: 10;
						listDirection: #leftToRight;
						vResizing: #shrinkWrap;
						hResizing: #shrinkWrap.

	dismissButton _ SimpleButtonMorph newWithLabel: 'dismiss'.
	dismissButton 
		color: self buttonColor;
		target: self;
		actionSelector: #delete.

	unconstrainButton _ SimpleButtonMorph newWithLabel: 'remove all constraints'.
	unconstrainButton
		color: self buttonColor;
		target: self;
		actionSelector: #removeAllConstraints.

	buttonArea 
		addMorph: dismissButton;
		addMorph: unconstrainButton.

	self 
		addMorph: buttonArea;
		addMorph: che!
ckBoxArea;
		addMorph: constraintHolder;
		addMorph: (StringMorph contents: 'Constraints for World')! !

!MultipleConstraintMorph methodsFor: 'stepping and presenter' stamp: 'jcg 1/6/2002 23:35'!
step
	"Decide which constraints should be displayed, and display them."
	| newConstraints |

	"Remove morphs for constraints that are outdated."
	newConstraints _ constraintSource constraints.
	constraints keys do: [:key | 
		(newConstraints includes: key) ifFalse: [
			(constraints at: key) delete.
			constraints removeKey: key]].

	"Prepare to rebuild."
	constraintHolder removeAllMorphs.

	"If we don't yet have a morph to view a particular constraint, create one."
	newConstraints do: [:constraint |
		constraints 
			at: constraint 
			ifAbsentPut: [
				ConstraintViewerMorph forConstraint: constraint andLiason: self liason]].

	"Update morphs, and add them to viewing area."
	constraints do: [:morph |
		morph update.
		(self shouldShow: morph) ifTrue: [
			constraintHolder addMorph!
: morph]]
	! !

!MultipleConstraintMorph methodsFor: 'stepping and presenter' stamp: 'jcg 1/3/2002 13:52'!
stepTime
	
	^ 500! !

!MultipleConstraintMorph methodsFor: 'visual properties' stamp: 'jcg 1/8/2002 02:57'!
buttonColor
	"Default color for all UI buttons."

	^ Color green muchLighter! !

!MultipleConstraintMorph methodsFor: 'private' stamp: 'jcg 1/6/2002 23:31'!
removeAllConstraints
	"After receiving confirmation, remove all of the constraints on constraintSource (semantics are a bit different depending on whether it is a SolverLiason or Constrainer)."
	| confirmation |

	confirmation _ PopUpMenu confirm: 
						'This will remove all constraints ', 
						(constraintSource isLiason 
							ifTrue: ['in the entire World.  ']
							ifFalse: ['for this morph.  ']),
						'Do you really want to do this?'.
	confirmation ifFalse: [^ self].

	constraintSource isLiason
		ifTrue: [constraintSource removeAllConstraints]
		ifFalse: [constraintSource becomeUnconstrained] "constr!
aintSource is a Constrainer"! !

!MultipleConstraintMorph methodsFor: 'private' stamp: 'jcg 1/6/2002 15:59'!
shouldShow: cvMorph
	"Answer true if the given morph should be viewed, based on the information the user is interested in seeing."

	^ self showDefaultConstraints
		ifFalse: [cvMorph constraint isDefaultConstraint not]
		ifTrue: [true]

	! !


!MultipleConstraintMorph class methodsFor: 'instance creation' stamp: 'jcg 1/3/2002 13:25'!
newWithConstraintSource: aConstrainerOrSolverLiason

	^ self new constraintSource: aConstrainerOrSolverLiason! !


!ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'jcg 8/9/2001 10:31'!
rebuild

	self removeAllMorphs.
	self addARow: {
		self lockedString: 'Properties for ',myTarget name.
	}.
	self addARow: {
		self inAColumn: {
			self paneForCornerRoundingToggle.
			self paneForStickinessToggle.
			self paneForLockedToggle.
		}.
	}.

	self addARow: {
		self paneForMainColorPicker.
		self paneFor2ndGradientColorPicker.
	}.
!
	self addARow: {
		self paneForBorderColorPicker.
		self paneForShadowColorPicker.
	}.

	myTarget isConstrained ifTrue: [
		self addARow: { self paneForConstraints }].

	self addARow: {
		self 
			buttonNamed: 'Accept' action: #doAccept color: color lighter 
			help: 'keep changes made and close panel'.
		self 
			buttonNamed: 'Cancel' action: #doCancel color: color lighter 
			help: 'cancel changes made and close panel'.
	}, self rebuildOptionalButtons.

	thingsToRevert _ Dictionary new.
	"thingsToRevert at: #fillStyle: put: myTarget fillStyle."
	(myTarget isKindOf: SystemWindow) ifTrue: [
		thingsToRevert at: #setWindowColor: put: myTarget paneColorToUse
	].
	thingsToRevert at: #hasDropShadow: put: myTarget hasDropShadow.
	thingsToRevert at: #shadowColor: put: myTarget shadowColor.
	(myTarget respondsTo: #borderColor:) ifTrue: [
		thingsToRevert at: #borderColor: put: myTarget borderColor.
	].

	thingsToRevert at: #borderWidth: put: myTarget borderWidth.
	thingsToRevert at!
: #cornerStyle: put: myTarget cornerStyle.
	thingsToRevert at: #sticky: put: myTarget isSticky.
	thingsToRevert at: #lock: put: myTarget isLocked.
! !

!ObjectPropertiesMorph methodsFor: 'panes' stamp: 'jcg 8/9/2001 10:27'!
paneForConstraints

	^self 
		inAColumn: {
			self 
				colorPickerFor: self
				getter: #targetBorderColor
				setter: #targetBorderColor:.
			self lockedString: 'Border Color'.
			(self paneForBorderToggles)  hResizing: #shrinkWrap.
			self paneForBorderWidth.
		} 
		named: #pickerForBorderColor.

! !


!PasteUpMorph methodsFor: 'accessing' stamp: 'jcg 7/5/2001 11:09'!
worldState

	^ worldState! !

!PasteUpMorph methodsFor: 'morphowary' stamp: 'jcg 1/2/2002 13:36'!
assuredLiason
	"Answer the liason to our constraint solvers, creating one first if necessary."

	self isWorldMorph 
		ifTrue: [^ worldState assuredLiason]
		ifFalse: [self error: 'Only Worlds have solver liasons'. ^ nil].
! !

!PasteUpMorph methodsFor: 'morphowary' stamp: 'jcg 1/2/2002 13:49'!
!
destroyLiason
	"If I am a world, destroy the liason to constraint solvers (world will become unconstrained)."

	self isWorldMorph ifTrue: [worldState destroyLiason]
! !

!PasteUpMorph methodsFor: 'morphowary' stamp: 'jcg 1/2/2002 13:38'!
hasLiason

	^ self isWorldMorph 
		ifTrue: [worldState hasLiason]
		ifFalse: [false]
! !

!PasteUpMorph methodsFor: 'morphowary' stamp: 'jcg 1/2/2002 13:32'!
liason

	^ self isWorldMorph ifTrue: [worldState liason]
! !


!PolygonMorph methodsFor: 'geometry' stamp: 'jcg 1/8/2002 10:41'!
extent: newExtent 
	"Not really advisable, but we can preserve most of the geometry if we don't
	shrink things too small."
	| safeExtent center |
	self extent = newExtent ifTrue: [^ self].   "no change in extent"
	center _ self referencePosition.
	safeExtent _ newExtent max: 20 at 20.
	self setVertices: (vertices collect:
		[:p | p - center * (safeExtent asFloatPoint / (self extent max: 1 at 1)) + center])! !


!Preferences class methodsFor: 'personalization' stam!
p: 'jcg 1/2/2002 13:41'!
addMorphowaryItems: aMenu

		{'Morphowary Design'. 'TO-DO'. 'Morphowary'. 'Design Decisions'. 'Demo Plan'. 'Project Goals'. 'Future Directions'} 
		do: [:projectName |
			aMenu 
				add: 'Enter ', projectName 
				target: Project 
				selector: #enter: 
				argument: projectName].

	aMenu addLine.
	aMenu currentWorld hasLiason ifTrue: [ 
		aMenu 
			addUpdating: #activationString
			target: aMenu currentWorld liason
			action: #toggleActivation].
	aMenu addLine.! !


!SolverLiason methodsFor: 'accessing' stamp: 'jcg 1/3/2002 11:38'!
activated
	"Answer true if constraints are being solved, and false otherwise."

	^ activated! !

!SolverLiason methodsFor: 'accessing' stamp: 'jcg 1/3/2002 11:45'!
activated: aBoolean
	"Turn on or off the solving of constraints."

	activated == aBoolean ifTrue: [^ self].
	activated _ aBoolean.

	"We want all constrained morphs to try to keep their current positions upon solver activation."
	activated ifTrue: [editConstrai!
ners addAll: self allConstrainers].! !

!SolverLiason methodsFor: 'accessing' stamp: 'jcg 1/3/2002 13:32'!
activeConstrainers
	"Answer all of the constrainers involved in my active constraints."
	| constrainers |

	constrainers _ Set new.
	activeConstraints do: [:constraint | constrainers addAll: constraint constrainers].
	^ constrainers! !

!SolverLiason methodsFor: 'accessing' stamp: 'jcg 1/3/2002 13:45'!
allConstrainers
	"Answer all of the constrainers involved in the constraints that I know about."
	| constrainers |

	constrainers _ Set new.
	self constraints do: [:constraint | constrainers addAll: constraint constrainers].
	^ constrainers! !

!SolverLiason methodsFor: 'accessing' stamp: 'jcg 1/3/2002 13:45'!
constraints
	"Answer a collection including both my active and passive constraints."

	^ activeConstraints copy 
		addAll: passiveConstraints;
		yourself! !

!SolverLiason methodsFor: 'accessing' stamp: 'jcg 1/3/2002 11:46'!
editConstrainers
	"Answer all constrainer!
s that have variables whose values have been changed by someone other than the constraint solvers."

	editConstrainers ifNil: [self clearEditConstrainers].
	^ editConstrainers! !

!SolverLiason methodsFor: 'accessing' stamp: 'jcg 1/3/2002 13:27'!
isLiason

	^ true! !

!SolverLiason methodsFor: 'cassowary-specific' stamp: 'jcg 1/2/2002 19:19'!
solveConstraints
	"This is specific to Cassowary.  In the event that another type of constraint solver becomes available, this would probably be put into a new class (Solver?) that provides a consistent interface to the different solvers.  SolverLiason would then focus on the role of talking between
the World and the Solvers."

	self editConstrainers do: [:con | 
		con editedVariables do: [:var |
			solver addEditVar: var strength: ClStrength strong]].

	solver beginEdit.

	self editConstrainers do: [:con |
		con editedVariables with: con editedValues do: [:var :val |
			solver suggestValue: var newValue: val]].

	solver 
		resolve;
		e!
ndEdit.! !

!SolverLiason methodsFor: 'constraint management' stamp: 'jcg 1/3/2002 14:42'!
activateConstraint: constraint
	"Try to activate the given constraint, answering true if activation occurs, and false otherwise.  Activation does not occur if:
		- constraint is already active
		- constraint is not known to this solver (hasn't already been added)
		- some of the morphs constrainted by the constraint are not in the world of this solver"

	"Check if activation can occur."
	(self canActivateConstraint: constraint) ifFalse: [^ false].

	"OK to activate constraint; do so."
	constraint rawConstraints do: [:rawConstraint | solver addConstraint: rawConstraint].
	passiveConstraints remove: constraint.
	activeConstraints add: constraint.
	^ true


! !

!SolverLiason methodsFor: 'constraint management' stamp: 'jcg 1/2/2002 14:29'!
addConstraint: constraint
	"Add constraint without immediately activating it."

	((activeConstraints copy addAll: passiveConstraints) includes: constra!
int) ifTrue: [^ self].
	
	passiveConstraints add: constraint.
	constraint noteAdditionTo: self! !

!SolverLiason methodsFor: 'constraint management' stamp: 'jcg 1/2/2002 21:03'!
addConstraintImmediately: constraint
	"Add constraint and immediately activate it."

	self addConstraint: constraint.
	self activateConstraint: constraint! !

!SolverLiason methodsFor: 'constraint management' stamp: 'jcg 1/3/2002 14:42'!
canActivateConstraint: aConstraint
	"Answer true if it is possible to activate this constraint, and false otherwise."

	(self constraints includes: aConstraint) ifFalse: [^ false].
	^ aConstraint constrainedMorphsAllInWorld: self world! !

!SolverLiason methodsFor: 'constraint management' stamp: 'jcg 1/3/2002 11:56'!
deactivateConstraint: constraint
	"Try to activate the given constraint, answering true if deactivation occurs, and false otherwise."

	"Check if deactivation occurs."
	(passiveConstraints includes: constraint) ifTrue: [^ false].
	(activeConstraints incl!
udes: constraint) ifFalse: [^ false].

	"OK to deactivate constraint; do so."
	constraint rawConstraints do: [:rawConstraint | solver removeConstraint: rawConstraint].
	solver removeEmptyColumns.
	activeConstraints remove: constraint.
	passiveConstraints add: constraint.
	^ true

	! !

!SolverLiason methodsFor: 'constraint management' stamp: 'jcg 1/3/2002 11:40'!
removeAllConstraints
	"Remove both my active and passive constraints."

	activeConstraints copy do: [:con | self removeConstraint: con].
	passiveConstraints copy do: [:con | self removeConstraint: con].! !

!SolverLiason methodsFor: 'constraint management' stamp: 'jcg 1/2/2002 14:31'!
removeConstraint: constraint	
	"Try to remove the given constraint, answering true if removal occurs, and false otherwise."

	"Deactivate active constraints before removal."
	(activeConstraints includes: constraint) ifTrue: [
		self deactivateConstraint: constraint].

	"If constraint was active before, it is now in here.  If it is not !
here, we didn't know about it."
	passiveConstraints remove: constraint ifAbsent: [^ false].

	constraint noteRemovalFrom: self.
	solver removeEmptyColumns.		"Cassowary clean-up."
	^ true
! !

!SolverLiason methodsFor: 'debugging' stamp: 'jcg 1/2/2002 23:14'!
solver
	"Answer the actual constraint solver."

	^ solver! !

!SolverLiason methodsFor: 'event loop integration' stamp: 'jcg 1/2/2002 21:09'!
addEditConstrainer: aConstrainer
	"Note that a constrainer has had one or more of its variables provisionally changed.  When the constraints for this world are solved, these changes are taken into account.  Also see comment in WorldState>>doOneCycleNowFor:"

	self watching ifTrue: [self editConstrainers add: aConstrainer]
! !

!SolverLiason methodsFor: 'event loop integration' stamp: 'jcg 1/3/2002 11:43'!
clearEditConstrainers
	"Used for initialization of editConstrainers, as well as clearing it after constraints are solved."

	editConstrainers _ IdentitySet new! !

!SolverLiason m!
ethodsFor: 'event loop integration' stamp: 'jcg 1/3/2002 11:41'!
solveAndUpdateConstrainers
	"This is called once every world cycle to solve constraints and update the properties of morphs in the world."

	self activated ifFalse: [^ self].

	"Solve all systems of constraints."
	self solveConstraints.

	"Tell constrained morphs to update themselves from me."
	self allConstrainers do: [:constrainer | constrainer updateMorphValues]! !

!SolverLiason methodsFor: 'event loop integration' stamp: 'jcg 1/2/2002 14:32'!
watching
	"Answer true if I am paying attention to changes in constrained values, and false otherwise."

	^ watching ifNil: [watching _ false]! !

!SolverLiason methodsFor: 'event loop integration' stamp: 'jcg 1/2/2002 14:32'!
watching: aBoolean
	"Tells me to either pay attention to or ignore changes in constrained values."

	watching _ aBoolean
! !

!SolverLiason methodsFor: 'event loop integration' stamp: 'jcg 1/2/2002 21:10'!
world
	"Answers current world, but shou!
ld actually answer the world associated with this liason."
	| currentWorld |

	"Sanity check until better way to find our world is found."
	currentWorld _ self currentWorld.
	currentWorld liason == self ifFalse: [self error: 'Incorrect world for liason'].

	^ currentWorld! !

!SolverLiason methodsFor: 'initialization and finalization' stamp: 'jcg 1/2/2002 14:31'!
initialize

	solver _ ClSimplexSolver new.
	activeConstraints _ Set new.
	passiveConstraints _ Set new.
	activated _ true! !

!SolverLiason methodsFor: 'initialization and finalization' stamp: 'jcg 1/2/2002 14:31'!
prepareToBeAbandoned
	"My world is about to become unconstrained."

	self removeAllConstraints.
	solver _ activeConstraints _ passiveConstraints _ editConstrainers _ nil! !

!SolverLiason methodsFor: 'menu support' stamp: 'jcg 1/3/2002 11:19'!
activationString
	"Used to created updating menus."

	^ (self activated 
			ifTrue: ['<yes>'] 
			ifFalse: ['<no>']),
		'constraint solver activated'! !

!SolverLia!
son methodsFor: 'menu support' stamp: 'jcg 1/3/2002 14:15'!
displayConstraints

	^ (MultipleConstraintMorph newWithConstraintSource: self) openInHand! !

!SolverLiason methodsFor: 'menu support' stamp: 'jcg 1/3/2002 11:45'!
toggleActivation
	"Toggle whether or not constraints are to be solved."

	self activated: self activated not! !

!SolverLiason methodsFor: 'testing' stamp: 'jcg 1/2/2002 14:30'!
hasActiveConstraint: constraint
	"Answer true if this constraint is active for us."

	^ activeConstraints includes: constraint! !

!SolverLiason methodsFor: 'testing' stamp: 'jcg 1/2/2002 14:30'!
hasConstraint: constraint
	"Answer true if we already know about this constraint, regardless of whether it is currently active."

	^ (activeConstraints includes: constraint) or: [passiveConstraints includes: constraint]
! !

!SolverLiason methodsFor: 'testing' stamp: 'jcg 1/2/2002 14:31'!
hasPassiveConstraint: constraint
	"Answer true if this constraint is passive for us."

	^ passiveCons!
traints includes: constraint! !


!SolverLiason class methodsFor: 'examples' stamp: 'jcg 1/8/2002 02:43'!
demo1
	"Create some morphs, create a compound constraint involving them, and activate the constraint."
	"SolverLiason demo1"
	| morphs signCon topCon bottomCon leftCon rightCon liason |

	"Create the morphs which will be constrained in our first demonstration, and obtain constrainers for them."
	morphs _ (1 to: 4) collect: [:num | EllipseMorph new openInWorld
															borderWidth: 3;
															color: Color random;
															borderColor: Color random;
															center: World center].
	leftCon _ morphs first assuredConstrainer.
	rightCon _ morphs second assuredConstrainer.
	topCon _ morphs third assuredConstrainer.
	bottomCon _ morphs fourth assuredConstrainer.
	signCon _ self translucentButton openInWorld assuredConstrainer.

	"Set button action: unconstrain and delete all demo morphs."
	(signCon morph submorphNamed: 'Button') 
		on: #mouseDown 
		sen!
d: #value 
		to: [{signCon. leftCon. rightCon. topCon. bottomCon} do: [:constrainer | 
																	constrainer morph abandon]].

	"Now create the constraints (clearly, API here needs work)."
	liason _ World assuredLiason.

	liason addConstraintImmediately: 
		(Constraint newSystemConstraint 
			addAllConstraints: {
				signCon height cnGEQ: 100.
				signCon height cnEqual: signCon width.
				signCon top cnGEQ: topCon bottom + 10.
				signCon bottom cnLEQ: bottomCon top - 10.
				signCon left cnGEQ: leftCon right + 10.
				signCon right cnLEQ: rightCon left - 10};
			description: 'sign constraints').

	liason addConstraintImmediately: 
		(Constraint newSystemConstraint 
			addAllConstraints: {
				topCon top cnGEQ: 0.
				topCon left cnGEQ: leftCon right + 10.
				topCon right cnLEQ: rightCon left - 10.
				topCon width cnGEQ: 60.
				topCon height cnGEQ: 40};
			description: 'top ellipse constraints').	

	liason addConstraintImmediately: 
		(Constraint newSystemConstrai!
nt 
			addAllConstraints: {
				bottomCon bottom cnLEQ: World bottom.
				bottomCon left cnGEQ: leftCon right + 10.
				bottomCon right cnLEQ: rightCon left - 10.
				bottomCon width cnGEQ: 60 strength: ClStrength medium.
				bottomCon height cnGEQ: 40};
			description: 'bottom ellipse constraints').	
	
	liason addConstraintImmediately: 
		(Constraint newSystemConstraint 
			addAllConstraints: {
				leftCon left cnGEQ: 0.
				leftCon top cnGEQ: topCon bottom + 10.
				leftCon bottom cnLEQ: bottomCon top - 10.
				leftCon width cnGEQ: 60 strength: ClStrength medium weight: 2.
				leftCon height cnGEQ: 40};
			description: 'left ellipse constraints').	

	liason addConstraintImmediately: 
		(Constraint newSystemConstraint 
			addAllConstraints: {
				rightCon right cnLEQ: World right.
				rightCon top cnGEQ: topCon bottom + 10.
				rightCon bottom cnLEQ: bottomCon top - 10.
				rightCon width cnGEQ: 60 strength: ClStrength medium.
				rightCon height cnGEQ: 40};
			description:!
 'right ellipse constraints').	
	! !

!SolverLiason class methodsFor: 'examples' stamp: 'jcg 1/8/2002 10:37'!
demo2
	"Create a chain of stars, each linked to the previous one.  Try using the 'view constraints...' menu item of a star to disable its link to the next star."
	"SolverLiason demo2"
	| color sign stars con1 con2 |
	color _ Color white.
	stars _ OrderedCollection new.
	20 timesRepeat: [
		stars add: (StarMorph new openInWorld 
					color: color; 
					borderColor: color negated;
					extent: 40 at 40).
		color _ color darker].

	con1 _ stars first assuredConstrainer.
	stars copyWithoutFirst withIndexDo: [:star :ind |
		con2 _ star assuredConstrainer.
		World assuredLiason addConstraintImmediately:
			(Constraint newSystemConstraint addAllConstraints: {
				(con1 top cnLEQ: con2 top + 25).
				(con1 left cnLEQ: con2 left + 25).
				(con1 top cnGEQ: con2 top - 25).
				(con1 left cnGEQ: con2 left - 25)};
			description: 'link ', ind printString, ' between stars').
		con1!
 _ con2].

	sign _ self translucentButton openInWorld.
	(sign submorphNamed: 'Button')
		on: #mouseDown
		send: #value
		to: [stars, {sign} do: [:e | e abandon]].
! !

!SolverLiason class methodsFor: 'examples' stamp: 'jcg 1/2/2002 21:59'!
translucentButton
	"Answer a RecangleMorph with a EllipseMorph submorph with a TextMorph submorph.  The ellipse is named 'Button', and the text is named 'Button Text'.  Beyond this, it's up to the caller to actually turn it into a button."
	| border button text |

	border _ RectangleMorph new
				extent: 100 at 100;
				color: (Color gray alpha: 0.6).
	button _ EllipseMorph new
				extent: 80 at 60;
				setNamePropertyTo: 'Button'.
	text _ StringMorph contents: 'End Demo'.
	button center: border center.
	text center: button center.
	border addMorph: button.
	button addMorph: text.
	
	^ border
! !

!SolverLiason class methodsFor: 'utilities' stamp: 'jcg 1/2/2002 13:40'!
active
	"Answer the active liason, or nil if there isn't one."

	^ World worl!
dState ifNotNilDo: [:state | state liason]! !

!SolverLiason class methodsFor: 'utilities' stamp: 'jcg 1/2/2002 16:48'!
makeEverythingUnconstrained
	"Make everything in this entire image unconstrained.  Kinda slow."
	"SolverLiason makeEverythingUnconstrained"

	Morph allSubInstancesDo: [:m | m becomeUnconstrained].
	PasteUpMorph allSubInstancesDo: [:p | p destroyLiason]! !

!SolverLiason class methodsFor: 'utilities' stamp: 'jcg 1/2/2002 13:43'!
makeThisWorldUnconstrained
	"SolverLiason makeThisWorldUnconstrained"

	World allMorphs do: [:m | m becomeUnconstrained].
	World destroyLiason! !

!SolverLiason class methodsFor: 'instance creation' stamp: 'jcg 1/2/2002 14:20'!
new

	^ super new initialize! !


!TheWorldMenu methodsFor: 'construction' stamp: 'jcg 1/3/2002 11:19'!
buildWorldMenu
	"Build the menu that is put up when the screen-desktop is clicked on"

	| menu |
	menu _ MenuMorph new defaultTarget: self.
	self colorForDebugging: menu.
	menu addStayUpItem.
	self fillIn: m!
enu from: {
		{'previous project' . { #myWorld . #goBack } }.
		{'jump to project...' . { #myWorld . #jumpToProject } }.
		{'save project on file...' . { #myWorld  . #saveOnFile } }.
		{'load project from file...' . { self  . #loadProject } }.
		nil}.
	myWorld addUndoItemsTo: menu.

		self fillIn: menu from: {
		{'restore display (r)' . { World . #restoreMorphicDisplay } }.
		nil}.
	Preferences simpleMenus ifFalse:
		[self fillIn: menu from: { 
			{'open...' . { self  . #openWindow } }.
			{'windows...' . { self  . #windowsDo } }.
			{'changes...' . { self  . #changesDo } }}].
	self fillIn: menu from: { 
		{'help...' . { self  . #helpDo } }.
		{'appearance...' . { self  . #appearanceDo } }}.

	Preferences simpleMenus ifFalse:
		[self fillIn: menu from: {
			{'do...' . { Utilities . #offerCommonRequests} } }].

	self fillIn: menu from: { 
		nil.
		{'objects (o)' . { #myWorld . #activateObjectsTool } . 'A tool for finding and obtaining many kinds of objects'}.
		nil.
		{'new m!
orph...' . { self  . #newMorph }}.
		{'authoring tools...' . { self  . #scriptingDo } }.
		{'playfield options...' . { self  . #playfieldDo } }.
		{'flaps...'. { self . #flapsDo } }.
		{'projects...' . { self  . #projectDo } }}.
	Preferences simpleMenus ifFalse:
		[self fillIn: menu from: { 
			{'print PS to file...' . { self  . #printWorldOnFile } }.
			{'debug...' . { self  . #debugDo } }}].

	menu addLine.
	World hasLiason ifTrue: [ 
		menu 
			addUpdating: #activationString target: World liason action: #toggleActivation;
			add: 'view constraints...' target: World liason action: #displayConstraints;
			addLine].

	self fillIn: menu from: { 
		nil.
		{'save' . { self  . #saveSession } }.
		{'save as...' . { Smalltalk . #saveAs } }.
		{'save and quit' . { self  . #saveAndQuit } }.
		{'quit' . { self  . #quitSession } }}.

	^ menu! !


!WorldState methodsFor: 'update cycle' stamp: 'jcg 1/2/2002 13:39'!
doOneCycleNowFor: aWorld
	"Do one cycle of the interactive loop. This me!
thod is called repeatedly when the world is running."

	self flag: #bob.		"need to consider remote hands in lower worlds"
	"process user input events"
	LastCycleTime _ Time millisecondClockValue.
	self handsDo: [:h |
		ActiveHand _ h.
		h processEvents.
		ActiveHand _ nil
	].
	"the default is the primary hand"
	ActiveHand _ self hands first.
	aWorld runStepMethods.		"there are currently some variations here"

	"Morphowary integration: resolve the system of constraints.  Stop listening to changes to morphs (otherwise, updated morph properties will be seen as edited, causing unnecessary work for the solver next cycle), and update the relevant properties of constrained morphs.  Finally, start listening again for suggested changes to morphs."
	self hasLiason ifTrue: [
		self liason
			watching: false;
			solveAndUpdateConstrainers;
			clearEditConstrainers;
			watching: true].

	self displayWorldSafely: aWorld.
! !

!WorldState methodsFor: 'morphowary' stamp: 'jcg 1/2/2002 13:49!
'!
assuredLiason
	"Answer the liason to our constraint solvers, creating one first if necessary."

	^ liason ifNil: [liason _ SolverLiason new]! !

!WorldState methodsFor: 'morphowary' stamp: 'jcg 1/2/2002 13:48'!
destroyLiason
	"Destroy the liason to constraint solvers for this world (world will become unconstrained)."

	liason ifNotNil: [liason prepareToBeAbandoned].
	liason _ nil
! !

!WorldState methodsFor: 'morphowary' stamp: 'jcg 1/2/2002 13:49'!
hasLiason
	"Answer true if world has a liason to constraint solvers (ie: it is constrained)."

	^ liason notNil ! !

!WorldState methodsFor: 'morphowary' stamp: 'jcg 1/2/2002 13:46'!
liason
	"Answer the liason to constraint solvers for this world."

	^ liason ! !


!MorphowaryVariable class reorganize!
('instance creation' newWith:name:constrainer:)
!


!Morph reorganize!
('WiW support' addMorphInFrontOfLayer: addMorphInLayer: eToyRejectDropMorph:event: morphicLayerNumber morphicLayerNumberWithin: randomBoundsFor: shouldGetSte!
psFrom:)
('access properties' hasProperty: removeProperty: setProperty:toValue: valueOfProperty: valueOfProperty:ifAbsent: valueOfProperty:ifAbsentPut: valueOfProperty:ifPresentDo:)
('accessing' actorState actorState: actorStateOrNil asMorph balloonText balloonTextSelector balloonTextSelector: beFlap: beSticky beUnsticky borderColor borderColor: borderStyle borderStyle: borderStyleForSymbol: borderWidth borderWidth: borderWidthForRounding color color: colorForInsets couldHaveRoundedCorners eventHandler eventHandler: forwardDirection hasTranslucentColor highlight highlightColor highlightColor: highlightOnlySubmorph: insetColor isFlap isLocked isShared isSticky lock lock: methodCommentAsBalloonHelp modelOrNil player player: raisedColor regularColor regularColor: rememberedColor rememberedColor: resistsRemoval resistsRemoval: setBorderStyle: sqkPage sticky: toggleLocked toggleResistsRemoval toggleStickiness unHighlight unlock unlockContents url userString wantsToBeCachedByHand)!

('button' doButtonAction fire firedMouseUpCode)
('button properties' buttonProperties buttonProperties: ensuredButtonProperties hasButtonProperties)
('caching' fullLoadCachedState fullReleaseCachedState loadCachedState releaseCachedState)
('change reporting' addedOrRemovedSubmorph: changed colorChangedForSubmorph: invalidRect: invalidRect:from: ownerChanged userSelectedColor:)
('classification' isAlignmentMorph isBalloonHelp isFlapOrTab isFlapTab isFlashMorph isFlexMorph isHandMorph isModalShell isMorph isMorphicModel isPlayfieldLike isRenderer isStandardViewer isSyntaxMorph isWorldMorph isWorldOrHandMorph)
('copying' copy deepCopy duplicate fullCopy updateReferencesUsing: usableSiblingInstance veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:)
('debug and other' addDebuggingItemsTo:hand: addMouseActionIndicatorsWidth:color: addMouseUpAction addMouseUpActionWith: addViewingItemsTo: allStringsAfter: altSpecialCursor0 altSpecialCursor1 altSpecialCursor2 altSpecialCursor3 al!
tSpecialCursor3: buildDebugMenu: defineTempCommand deleteAnyMouseActionIndicators handMeTilesToFire inspectArgumentsPlayerInMorphic: inspectOwnerChain installModelIn: mouseUpCodeOrNil ownerChain programmedMouseDown:for: programmedMouseEnter:for: programmedMouseLeave:for: programmedMouseUp:for: programmedMouseUp:for:with: removeMouseUpAction reportableSize resumeAfterDrawError resumeAfterStepError tempCommand viewMorphDirectly)
('drawing' areasRemainingToFill: boundingBoxOfSubmorphs boundsWithinCorners changeClipSubmorphs clipLayoutCells clipLayoutCells: clipSubmorphs clipSubmorphs: clippingBounds doesOwnRotation drawDropHighlightOn: drawDropShadowOn: drawErrorOn: drawMouseDownHighlightOn: drawOn: drawOnCanvas: drawPostscriptOn: drawRolloverBorderOn: drawSubmorphsOn: expandFullBoundsForDropShadow: expandFullBoundsForRolloverBorder: flash fullDrawOn: fullDrawPostscriptOn: hasClipSubmorphsString hide highlightForMouseDown highlightForMouseDown: highlightedForMouseDown imageForm!
 imageForm:forRectangle: imageFormDepth: imageFormForRectangle: imageFormWithout:andStopThere: refreshWorld shadowForm show visible visible:)
('drop shadows' addDropShadow addDropShadowMenuItems:hand: changeShadowColor hasDropShadow hasDropShadow: hasDropShadowString hasRolloverBorder hasRolloverBorder: removeDropShadow setShadowOffset: shadowColor shadowColor: shadowOffset shadowOffset: shadowPoint: toggleDropShadow)
('dropping/grabbing' aboutToBeGrabbedBy: asDraggableMorph disableDragNDrop dragEnabled dragEnabled: dragNDropEnabled dragSelectionColor dropEnabled dropEnabled: dropHighlightColor dropSuccessColor enableDrag: enableDragNDrop enableDragNDrop: enableDrop: formerOwner formerOwner: formerPosition formerPosition: grabTransform highlightForDrop highlightForDrop: highlightedForDrop justDroppedInto:event: justGrabbedFrom: nameForUndoWording rejectDropMorphEvent: repelsMorph:event: resetHighlightForDrop separateDragAndDrop slideBackToFormerSituation: slideToTrash: start!
Drag:with: toggleDragNDrop transportedMorph undoGrabCommand vanishAfterSlidingTo:event: wantsDroppedMorph:event: wantsToBeDroppedInto: wantsToBeOpenedInWorld willingToBeDiscarded)
('e-toy support' adaptToWorld: adoptVocabulary: allMorphsAndBookPagesInto: appearsToBeSameCostumeAs: asNumber: asWearableCostume asWearableCostumeOfExtent: automaticViewing changeAllBorderColorsFrom:to: configureForKids containingWindow copyCostumeStateFrom: couldHoldSeparateDataForEachInstance creationStamp currentPlayerDo: cursor cursor: defaultFloatPrecisionFor: defaultValueOrNil defaultVariableName definePath deletePath embedInWindow embeddedInMorphicWindowLabeled: enclosingEditor enforceTileColorPolicy fenceEnabled followPath getNumericValue goToNextCardInStack goToPreviousCardInStack gridFormOrigin:grid:background:line: holdsSeparateDataForEachInstance isAViewer isCandidateForAutomaticViewing isStackBackground isTileEditor listViewLineForFieldList: makeGraphPaper makeGraphPaperGrid:background!
:line: makeHoldSeparateDataForEachInstance mustBeBackmost noteNegotiatedName:for: objectViewed referencePlayfield rotationStyle rotationStyle: setAsActionInButtonProperties: setAsDefaultValueForNewCard setNaturalLanguageTo: setNumericValue: setStandardTexture slotSpecifications stack stackDo: stopHoldingSeparateDataForEachInstance succeededInRevealing: textureParameters topEditor unlockOneSubpart updateCachedThumbnail wantsRecolorHandle wrappedInWindow: wrappedInWindowWithTitle:)
('event handling' click click: cursorPoint doubleClick: doubleClickTimeout: dropFiles: firstClickTimedOut: handlesKeyboard: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: handlesMouseStillDown: hasFocus keyDown: keyStroke: keyUp: keyboardFocusChange: mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: mouseMove: mouseStillDown: mouseStillDownThreshold mouseUp: on:send:to: on:send:to:withValue: removeLink: restoreSuspendedEventHandler startDrag: suspendEventHandl!
er transformFrom: transformFromOutermostWorld transformFromWorld wantsDropFiles: wantsEveryMouseMove wantsKeyboardFocusFor: wouldAcceptKeyboardFocus wouldAcceptKeyboardFocusUponTab)
('events-alarms' addAlarm:after: addAlarm:at: addAlarm:with:after: addAlarm:with:at: addAlarm:with:with:after: addAlarm:with:with:at: addAlarm:withArguments:after: addAlarm:withArguments:at: alarmScheduler removeAlarm: removeAlarm:at:)
('events-processing' containsPoint:event: defaultEventDispatcher handleDropFiles: handleDropMorph: handleEvent: handleFocusEvent: handleKeyDown: handleKeyUp: handleKeystroke: handleListenEvent: handleMouseDown: handleMouseEnter: handleMouseLeave: handleMouseMove: handleMouseOver: handleMouseStillDown: handleMouseUp: handleUnknownEvent: handlerForMouseDown: mouseDownPriority processEvent: processEvent:using: rejectDropEvent: rejectsEvent: transformedFrom:)
('fileIn/out' attachToResource objectForDataStream: prepareToBeSaved reserveUrl: saveAsResource saveDocPane sav!
eOnFile saveOnURL saveOnURL: saveOnURLbasic storeDataOn: updateAllFromResources updateFromResource)
('genie-dispatching' blueButtonClickHand:shift: gesture: gestureCode: gestureCommand: gestureKeystrokes: gestureMouseEvent: gestureStrokes: handleGesture: isGestureUndoable: isSpecialCharacterUndoable: modifyGesture:by: undoGesture:)
('genie-menu' addGenieMenuItems:hand: changeGestureDictionary hasNotExportedGestureDictionary hasReferencedGestureDictionary inspectGestureDictionary makeOwnCopyOfGestureDictionary makeOwnSubGestureDictionary)
('genie-processing' allowsGestureEscape allowsGesturePreprocessing allowsGestureStart: defaultGestureDictionaryOrName disableGestures gestureDictionary gestureDictionaryOrName gestureDictionaryOrName: gestureHandler gestureStart: handlesGestureStart: onGestureSend:to:)
('geometry' align:with: bottom bottom: bottomLeft bottomLeft: bottomRight bottomRight: bounds bounds: bounds:from: bounds:in: boundsIn: boundsInWorld center center: extent ext!
ent: fullBoundsInWorld globalPointToLocal: gridPoint: griddedPoint: height height: innerBounds left left: localPointToGlobal: minimumExtent minimumExtent: nextOwnerPage outerBounds point:from: point:in: pointFromWorld: pointInWorld: position position: positionInWorld positionSubmorphs previousOwnerPage right right: screenLocation screenRectangle setConstrainedPosition:hangOut: shiftSubmorphsBy: shiftSubmorphsOtherThan:by: top top: topLeft topLeft: topRight topRight: transformedBy: width width: worldBounds worldBoundsForHalo)
('geometry eToy' addTransparentSpacerOfSize: beTransparent cartesianBoundsTopLeft cartesianXY cartesianXY: color:sees: colorUnder degreesOfFlex forwardDirection: getIndexInOwner goHome heading heading: move:toPosition: referencePosition referencePosition: referencePositionInWorld referencePositionInWorld: rotationCenter rotationCenter: setDirectionFrom: setIndexInOwner: touchesColor: transparentSpacerOfSize: wrap x x: x:y: y y:)
('geometry testing' conta!
insPoint: fullContainsPoint: obtrudesBeyondContainer)
('halos and balloon help' addHalo addHalo: addHalo:from: addHandlesTo:box: addMagicHaloFor: addOptionalHandlesTo:box: addSimpleHandlesTo:box: addWorldHandlesTo:box: balloonColor balloonColor: balloonHelpAligner balloonHelpDelayTime balloonHelpTextForHandle: boundsForBalloon comeToFrontAndAddHalo defaultBalloonColor defersHaloOnClickTo: deleteBalloon editBalloonHelpContent: editBalloonHelpText halo haloClass haloDelayTime hasHalo hasHalo: isLikelyRecipientForMouseOverHalos mightEntertainDirectionHandles mouseDownOnHelpHandle: noHelpString okayToAddDismissHandle okayToAddGrabHandle okayToBrownDragEasily okayToExtractEasily okayToResizeEasily okayToRotateEasily removeHalo setBalloonText: setBalloonText:maxLineLength: setCenteredBalloonText: showBalloon: showBalloon:hand: transferHalo:from: wantsBalloon wantsDirectionHandles wantsDirectionHandles: wantsHalo wantsHaloFor: wantsHaloFromClick wantsHaloHandleWithSelector:inHalo: !
wantsScriptorHaloHandle)
('initialization' basicInitialize currentVocabulary inATwoWayScrollPane initialExtent initialize intoWorld: openCenteredInWorld openInHand openInMVC openInWindow openInWindowLabeled: openInWindowLabeled:inWorld: openInWorld openInWorld: outOfWorld: resourceJustLoaded standardPalette)
('layout' acceptDroppingMorph:event: adjustLayoutBounds doLayoutIn: fullBounds layoutBounds layoutBounds: layoutChanged layoutInBounds: layoutProportionallyIn: minExtent minHeight minHeight: minWidth minWidth: privateFullBounds submorphBounds)
('layout-menu' addCellLayoutMenuItems:hand: addLayoutMenuItems:hand: addTableLayoutMenuItems:hand: changeCellInset: changeClipLayoutCells changeDisableTableLayout changeLayoutInset: changeListDirection: changeMaxCellSize: changeMinCellSize: changeNoLayout changeProportionalLayout changeReverseCells changeRubberBandCells changeTableLayout hasClipLayoutCellsString hasDisableTableLayoutString hasNoLayoutString hasProportionalLayoutStr!
ing hasReverseCellsString hasRubberBandCellsString hasTableLayoutString layoutMenuPropertyString:from:)
('layout-properties' assureLayoutProperties assureTableProperties cellInset cellInset: cellPositioning cellPositioning: cellPositioningString: cellSpacing cellSpacing: cellSpacingString: disableTableLayout disableTableLayout: hResizing hResizing: hResizingString: layoutFrame layoutFrame: layoutInset layoutInset: layoutPolicy layoutPolicy: layoutProperties layoutProperties: listCentering listCentering: listCenteringString: listDirection listDirection: listDirectionString: listSpacing listSpacing: listSpacingString: maxCellSize maxCellSize: minCellSize minCellSize: reverseTableCells reverseTableCells: rubberBandCells rubberBandCells: spaceFillWeight spaceFillWeight: vResizeToFit: vResizing vResizing: vResizingString: wrapCentering wrapCentering: wrapCenteringString: wrapDirection wrapDirection: wrapDirectionString:)
('menus' absorbStateFromRenderer: adMiscExtrasTo: addAddHan!
dMenuItemsForHalo:hand: addCopyItemsTo: addCustomHaloMenuItems:hand: addCustomMenuItems:hand: addExportMenuItems:hand: addFillStyleMenuItems:hand: addHaloActionsTo: addPaintingItemsTo:hand: addPlayerItemsTo: addStackItemsTo: addStandardHaloMenuItemsTo:hand: addTitleForHaloMenu: addToggleItemsToHaloMenu: adhereToEdge adhereToEdge: adjustedCenter adjustedCenter: allMenuWordings changeColor changeDirectionHandles changeDragAndDrop chooseNewGraphic chooseNewGraphicCoexisting: chooseNewGraphicFromHalo collapse dismissButton displayConstraints doMenuItem: exportAsBMP exportAsGIF hasDirectionHandlesString hasDragAndDropEnabledString helpButton inspectInMorphic inspectInMorphic: lockUnlockMorph lockedString makeNascentScript maybeAddCollapseItemTo: menuItemAfter: menuItemBefore: presentHelp printPSToFile printPSToFileNamed: putOnBackground putOnForeground resetForwardDirection resistsRemovalString setRotationCenter setRotationCenterFrom: setToAdhereToEdge: snapToEdgeIfAppropriate st!
ickinessString transferStateToRenderer: uncollapseSketch)
('meta-actions' applyStatusToAllSiblings: beThisWorldsModel blueButtonDown: blueButtonUp: bringAllSiblingsToMe: buildHandleMenu: buildMetaMenu: changeColorTarget:selector:originalColor:hand: copyToPasteBuffer: dismissMorph dismissMorph: duplicateMorph: embedInto: grabMorph: handlerForBlueButtonDown: handlerForMetaMenu: inspectAt:event: invokeMetaMenu: invokeMetaMenuAt:event: makeMultipleSiblings: makeNewPlayerInstance: makeSiblings: makeSiblingsLookLikeMe: maybeDuplicateMorph maybeDuplicateMorph: openAButtonPropertySheet openAPropertySheet openATextPropertySheet potentialEmbeddingTargets resizeFromMenu resizeMorph: saveAsPrototype showActions showHiders subclassMorph)
('morphowary' assuredConstrainer becomeUnconstrained constrainer isConstrained)
('naming' choosePartName defaultNameStemForInstances downshiftedNameOfObjectRepresented externalName innocuousName knownName name: nameForFindWindowFeature nameInModel nameOf!
ObjectRepresented renameTo: setNamePropertyTo: setNameTo: specialNameInModel tryToRenameTo: updateAllScriptingElements)
('object fileIn' convertAugust1998:using: convertNovember2000DropShadow:using: convertToCurrentVersion:refStream:)
('parts bin' inPartsBin initializeToStandAlone isPartsBin isPartsDonor isPartsDonor: markAsPartsDonor partRepresented residesInPartsBin)
('pen' choosePenColor: choosePenSize getPenColor getPenDown getPenSize liftPen lowerPen penColor: penUpWhile: trailMorph)
('piano rolls' addMorphsTo:pianoRoll:eventTime:betweenTime:and: encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: justDroppedIntoPianoRoll:event: pauseFrom: resetFrom: resumeFrom: triggerActionFromPianoRoll)
('player' assureExternalName assuredCardPlayer assuredPlayer currentDataValue newPlayerInstance okayToDuplicate shouldRememberCostumes showPlayerMenu variableDocks)
('player commands' beep beep: jumpTo: makeFenceSound set:)
('player viewer' openViewerForArgument updateLi!
teralLabel)
('printing' asEPS asPostscript asPostscriptPrintJob clipPostscript colorString: constructorString defaultLabelForInspector fullPrintOn: initString morphReport morphReportFor: morphReportFor:on:indent: pagesHandledAutomatically printConstructorOn:indent: printConstructorOn:indent:nodeDict: printOn: printSpecs printSpecs: printStructureOn:indent: structureString textToPaste)
('property extension' assureExtension extension otherProperties resetExtension)
('rotate scale and flex' addFlexShell addFlexShellIfNecessary keepsTransform newTransformationMorph rotationDegrees)
('rounding' cornerStyle: roundedCorners roundedCornersString toggleCornerRounding wantsRoundedCorners)
('scripting' asEmptyPermanentScriptor bringTileScriptingElementsUpToDate bringUpToDate categoriesForViewer instantiatedUserScriptsDo: isTileLike isTileScriptingElement jettisonScripts makeAllTilesColored makeAllTilesGreen restoreTypeColor scriptEditorFor: scriptPerformer selectorsForViewer tearOffTil!
e triggerScript: useUniformTileColor viewAfreshIn:showingScript:at:)
('stepping and presenter' arrangeToStartStepping arrangeToStartSteppingIn: isStepping isSteppingSelector: start startStepping startStepping:at:arguments:stepTime: startSteppingIn: startSteppingSelector: step stepAt: stepTime stop stopStepping stopSteppingSelector: stopSteppingSelfAndSubmorphs wantsSteps)
('structure' activeHand allOwners allOwnersDo: firstOwnerSuchThat: hasOwner: isInWorld morphPreceding: nearestOwnerThat: orOwnerSuchThat: outermostMorphThat: outermostWorldMorph owner ownerThatIsA: ownerThatIsA:orA: pasteUpMorph pasteUpMorphHandlingTabAmongFields presenter primaryHand privateBounds: renderedMorph root rootAt: topPasteUp topRendererOrSelf withAllOwners withAllOwnersDo: world)
('submorphs-accessing' allKnownNames allMorphs allMorphsDo: allNonSubmorphMorphs allSubmorphNamesDo: findA: findDeepSubmorphThat:ifAbsent: findDeeplyA: findSubmorphBinary: firstSubmorph hasSubmorphWithProperty: hasSubmo!
rphs indexOfMorphAbove: lastSubmorph morphsAt: morphsAt:behind:unlocked: morphsAt:unlocked: morphsAt:unlocked:do: morphsInFrontOf:overlapping:do: morphsInFrontOverlapping: morphsInFrontOverlapping:do: rootMorphsAt: rootMorphsAtGlobal: shuffleSubmorphs submorphAfter submorphBefore submorphCount submorphNamed: submorphNamed:ifNone: submorphOfClass: submorphThat:ifNone: submorphWithProperty: submorphs submorphsBehind:do: submorphsDo: submorphsInFrontOf:do: submorphsReverseDo: submorphsSatisfying:)
('submorphs-add/remove' abandon actWhen actWhen: addAllMorphs: addAllMorphs:after: addMorph: addMorph:after: addMorph:asElementNumber: addMorph:behind: addMorph:fullFrame: addMorph:inFrontOf: addMorphBack: addMorphCentered: addMorphFront: addMorphFront:fromWorldPosition: addMorphNearBack: comeToFront copyWithoutSubmorph: delete deleteSubmorphsWithProperty: dismissViaHalo goBehind privateDelete removeAllMorphs removeAllMorphsIn: replaceSubmorph:by: submorphIndexOf:)
('testing' canDrawA!
tHigherResolution canDrawBorder: completeModificationHash isFlexed modificationHash shouldDropOnMouseUp)
('texture support' asTexture installAsWonderlandTextureOn: isValidWonderlandTexture isValidWonderlandTexture: mapPrimitiveVertex: wonderlandTexture wonderlandTexture:)
('thumbnail' demandsThumbnailing morphRepresented permitsThumbnailing readoutForField: representativeNoTallerThan:norWiderThan:thumbnailHeight: updateThumbnailUrl updateThumbnailUrlInBook:)
('undo' commandHistory undoMove:redo:owner:bounds:predecessor:)
('visual properties' canHaveFillStyles canSetColor cornerStyle defaultColor fillStyle fillStyle: fillWithRamp:oriented: useBitmapFill useDefaultFill useGradientFill useSolidFill)
('watching' addBoundsWatcher: boundsWatchers hasBoundsWatchers removeBoundsWatcher:)
('private' moveWithPenDownBy: moveWithPenDownByRAA: myEvents myEvents: privateAddMorph:atIndex: privateColor: privateDeleteWithAbsolutelyNoSideEffects privateFullBounds: privateFullMoveBy: privateMo!
veBy: privateOwner: privateRemoveMorph: privateRemoveMorphWithAbsolutelyNoSideEffects: privateSubmorphs privateSubmorphs:)
('other events' menuButtonMouseEnter: menuButtonMouseLeave:)
('miscellaneous' setExtentFromHalo:)
('menu' addBorderStyleMenuItems:hand:)
('card in a stack' abstractAModel beAStackBackground containsCard: currentDataInstance explainDesignations insertAsStackBackground insertCard installAsCurrent: newCard reassessBackgroundShape relaxGripOnVariableNames reshapeBackground showBackgroundObjects showDesignationsOfObjects showForegroundObjects tabHitWithEvent: wrapWithAStack)
('messenger' affiliatedSelector)
('other' removeAllButFirstSubmorph)
!
-------------- next part --------------
'From Squeak3.2alpha of 3 October 2001 [latest update: #4599] on 31 December 2001 at 4:11:04 pm'!
"Change Set:		MorphBoundsRefactoring
Date:			31 December 2001
Author:			Joshua Gargus

Changes direct gets/sets of 'bounds' into sends of #bounds and #privateBounds:.  An example of when this might be useful is when where a higher level system cares when a Morph's bounds change (I used it to integrate Cassowary with Morphic).

For the selfish reason that it was a pain to bring this up to date from a summer version, I urge harvesters to consider this changeset.  Profiling shows that performance is virtually unchanged; the extra flexibility comes essentially for free."!


!Morph methodsFor: 'copying' stamp: 'jcg 7/2/2001 00:29'!
veryDeepInner: deepCopier
	"The inner loop, so it can be overridden when a field should not be traced."

	"super veryDeepInner: deepCopier.	know Object has no inst vars"
	self privateBounds: self bounds clone.	"Points are shared with original"
	"owner _ ow!
ner.	special, see veryDeepFixupWith:"
	submorphs _ submorphs veryDeepCopyWith: deepCopier.
		"each submorph's fixup will install me as the owner"
	"fullBounds _ fullBounds.	fullBounds is shared with original!!"
	color _ color veryDeepCopyWith: deepCopier.
		"color, if simple, will return self. may be complex"
	extension _ extension veryDeepCopyWith: deepCopier.
		"extension is treated like any generic inst var"
! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'jcg 7/1/2001 22:32'!
addMorphCentered: aMorph

	aMorph position: self center - (aMorph extent // 2).
	self addMorphFront: aMorph.
! !

!Morph methodsFor: 'drawing' stamp: 'jcg 12/31/2001 15:30'!
boundingBoxOfSubmorphs
	| aBox |
	aBox _ self position extent: self minimumExtent.  "so won't end up with something empty"
	submorphs do:
		[:m | m visible ifTrue: [aBox _ aBox quickMerge: m fullBounds]].
	^ aBox
! !

!Morph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:32'!
drawErrorOn: aCanvas
	"The morph (or one of its !
submorphs) had an error in its drawing method."
	aCanvas
		frameAndFillRectangle: self bounds
		fillColor: Color red
		borderWidth: 1
		borderColor: Color yellow.
	aCanvas line: self topLeft to: self bottomRight width: 1 color: Color yellow.
	aCanvas line: self topRight to: self bottomLeft width: 1 color: Color yellow.! !

!Morph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:33'!
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."
	| canvas |
	canvas _ (Display defaultCanvasClass extent: self extent depth: 1)
				asShadowDrawingCanvas: Color black. "Color black represents one for 1bpp"
	canvas translateBy: self topLeft negated
		during:[:tempCanvas| tempCanvas fullDrawMorph: self].
	^ canvas form offset: self topLeft
! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:26'!
bottom

	^ self bounds bottom! !

!Morph methodsFor: 'geometry' stamp: 'jcg 12/31/2001 15:30'!
bo!
ttom: aNumber
	self position: (self left @ (aNumber - self height))! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:28'!
bottomLeft

	^ self bounds bottomLeft! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:26'!
bottomRight

	^ self bounds bottomRight! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:29'!
center

	^ self bounds center! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:29'!
extent

	^ self bounds extent! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:33'!
extent: aPoint

	self extent = aPoint ifTrue: [^ self].
	self changed.
	self privateBounds: (self topLeft extent: aPoint).
	self layoutChanged.
	self changed.
! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:30'!
height

	^ self bounds height! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:30'!
innerBounds
	"Return the inner rectangle enclosed by the bounds of this morph excluding the space taken by its borders. For an unbordered morph, this is!
 just its bounds."

	^ self bounds! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:30'!
left

	^ self bounds left! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:35'!
left: aNumber
	self position: (aNumber @ self top)! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:31'!
position

	^ self bounds topLeft! !

!Morph methodsFor: 'geometry' stamp: 'jcg 12/31/2001 15:31'!
position: aPoint
	"Change the position of this morph and and all of its submorphs."

	| delta box |
	delta _ aPoint - self position.
	(delta x = 0 and: [delta y = 0]) ifTrue: [^ self].  "Null change"
	box _ self fullBounds.
	(delta dotProduct: delta) > 100 ifTrue:[
		"e.g., more than 10 pixels moved"
		self invalidRect: box.
		self invalidRect: (box translateBy: delta).
	] ifFalse:[
		self invalidRect: (box merge: (box translateBy: delta)).
	].
	self privateFullMoveBy: delta.! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:31'!
right

	^ self bounds right! !

!Morph methods!
For: 'geometry' stamp: 'jcg 12/31/2001 15:31'!
right: aNumber
	self position: ((aNumber - self width) @ self top)! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:30'!
top

	^ self bounds top! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:34'!
top: aNumber
	self position: (self left @ aNumber)! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:27'!
topLeft

	^ self bounds topLeft! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:28'!
topRight

	^ self bounds topRight! !

!Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:26'!
width

	^ self bounds width! !

!Morph methodsFor: 'geometry eToy' stamp: 'jcg 7/1/2001 22:34'!
cartesianBoundsTopLeft
	"Answer the origin of this morph relative to it's container's cartesian origin. 
	NOTE: y DECREASES toward the bottom of the screen"

	| w container |

	w _ self world ifNil: [^ self bounds origin].
	container _ self referencePlayfield ifNil: [w].
	^ (self left - container cartesianOrigin x) @
		(c!
ontainer cartesianOrigin y - self top)! !

!Morph methodsFor: 'geometry eToy' stamp: 'jcg 7/1/2001 22:33'!
x: aNumber
	"Set my horizontal position relative to the cartesian origin of the playfield or the world."

	|  offset  aPlayfield newX |

	aPlayfield _ self referencePlayfield.
	offset _ self left - self referencePosition x.
	aPlayfield == nil
		ifTrue: [newX _ aNumber + offset]
		ifFalse: [newX _ aPlayfield cartesianOrigin x + aNumber + offset].
	self position: newX at self top.

! !

!Morph methodsFor: 'geometry eToy' stamp: 'jcg 12/31/2001 15:33'!
y
	"Return my vertical position relative to the cartesian origin of the playfield or the world. Note that larger y values are closer to the top of the screen."
	| w aPlayfield |

	w _ self world ifNil: [^ self top].
	aPlayfield _ self referencePlayfield.

	^ aPlayfield == nil
		ifTrue: [w cartesianOrigin y - self referencePosition y]
		ifFalse: [aPlayfield cartesianOrigin y - self referencePosition y]! !

!Morph methodsFor: 'ge!
ometry eToy' stamp: 'jcg 7/1/2001 22:35'!
y: aNumber
	"Set my vertical position relative to the cartesian origin of the playfield or the world. Note that larger y values are closer to the top of the screen."

	| w offset newY aPlayfield |

	w _ self world.
	w ifNil: [^ self position: self left @ aNumber].
	aPlayfield _ self referencePlayfield.
	offset _ self top - self referencePosition y.
	aPlayfield == nil
		ifTrue: [newY _ (w bottom - aNumber) + offset]
		ifFalse: [newY _ (aPlayfield cartesianOrigin y - aNumber) + offset].
	self position: self left @ newY.
! !

!Morph methodsFor: 'menus' stamp: 'jcg 7/1/2001 22:33'!
snapToEdgeIfAppropriate
	| edgeSymbol oldBounds aWorld |
	(edgeSymbol _ self valueOfProperty: #edgeToAdhereTo) ifNotNil:
		[oldBounds _ self bounds.
		self adhereToEdge: edgeSymbol.
		self bounds ~= oldBounds ifTrue: [(aWorld _ self world) ifNotNil: [aWorld viewBox ifNotNil:
			[aWorld displayWorld]]]]! !

!Morph methodsFor: 'printing' stamp: 'jcg 7/1/2001 22:!
34'!
fullPrintOn: aStream

	aStream nextPutAll: self class name , ' newBounds: (';
		print: self bounds;
		nextPutAll: ') color: ' , (self colorString: color)! !

!Morph methodsFor: 'private' stamp: 'jcg 12/31/2001 15:47'!
privateBounds: boundsRect
	"Private!! Use position: and/or extent: instead."

	fullBounds _ nil.
	^ bounds _ boundsRect.! !

!Morph methodsFor: 'private' stamp: 'jcg 7/1/2001 22:35'!
privateMoveBy: delta
	"Private!! Use 'position:' instead."
	| fill |
	extension ifNotNil:[
		extension player ifNotNil:[
			"Most cases eliminated fast by above test"
			self getPenDown ifTrue:[
				"If this is a costume for a player with its pen down, draw a line."
				self moveWithPenDownBy: delta]]].
	self privateBounds: (self bounds translateBy: delta).
	fullBounds ifNotNil:[fullBounds _ fullBounds translateBy: delta].
	fill _ self fillStyle.
	fill isOrientedFill ifTrue:[fill origin: fill origin + delta].
! !

!Morph methodsFor: 'undo' stamp: 'jcg 7/1/2001 22:34'!
undoMove!
: cmd redo: redo owner: formerOwner bounds: formerBounds predecessor: formerPredecessor
	"Handle undo and redo of move commands in morphic"

	self owner ifNil: [^ self beep].
	redo ifFalse:
		["undo sets up the redo state first"
		cmd redoTarget: self
			selector: #undoMove:redo:owner:bounds:predecessor:
			arguments: {cmd. true. owner. self bounds. (owner morphPreceding: self)}].

	formerOwner ifNotNil:
		[formerPredecessor
			ifNil: [formerOwner addMorphFront: self]
			ifNotNil: [formerOwner addMorph: self after: formerPredecessor]].
	self bounds: formerBounds.
	(self isKindOf: SystemWindow) ifTrue: [self activate]! !

!Morph methodsFor: 'layout' stamp: 'jcg 7/1/2001 11:47'!
layoutBounds: aRectangle
	"Set the bounds for laying out children of the receiver.
	Note: written so that #layoutBounds can be changed without touching this method"
	| outer inner |
	outer _ self bounds.
	inner _ self layoutBounds.
	self privateBounds: 
		(aRectangle origin + (outer origin - inner orig!
in) corner:
				aRectangle corner + (outer corner - inner corner)).! !

!Morph methodsFor: 'layout' stamp: 'jcg 9/4/2001 10:01'!
layoutInBounds: cellBounds
	"Layout specific. Apply the given bounds to the receiver after being layed out in its owner."
	| box aSymbol delta |
	fullBounds ifNil:["We are getting new bounds here but we haven't computed the receiver's layout yet. Although the receiver has reported its minimal size before the actual size it has may differ from what would be after the layout. Normally, this isn't a real problem, but if we have #shrinkWrap constraints then the receiver's bounds may be larger than the cellBounds. THAT is a problem because the centering may not work correctly if the receiver shrinks after the owner layout has been computed. To avoid this problem, we compute the receiver's layout now. Note that the layout computation is based on the new cell bounds rather than the receiver's current bounds."
		cellBounds origin = self bounds origin ifFal!
se:[
			box _ self outerBounds.
			delta _ cellBounds origin - self bounds origin.
			self invalidRect: (box merge: (box translateBy: delta)).
			self privateFullMoveBy: delta]. "sigh..."
		box _ cellBounds origin extent: "adjust for #rigid receiver"
			(self hResizing == #rigid ifTrue:[self bounds extent x] ifFalse:[cellBounds extent x]) @
			(self vResizing == #rigid ifTrue:[self bounds extent y] ifFalse:[cellBounds extent y]).
		"Compute inset of layout bounds"
		box _ box origin - (self bounds origin - self layoutBounds origin) corner:
					box corner - (self bounds corner - self layoutBounds corner).
		"And do the layout within the new bounds"
		self layoutBounds: box.
		self doLayoutIn: box].
	cellBounds = self fullBounds ifTrue:[^self]. "already up to date"
	cellBounds extent = self fullBounds extent "nice fit"
		ifTrue:[^self position: cellBounds origin].
	box _ self bounds.
	"match #spaceFill constraints"
	self hResizing == #spaceFill 
		ifTrue:[box _ box origin ext!
ent: cellBounds width @ box height].
	self vResizing == #spaceFill
		ifTrue:[box _ box origin extent: box width @ cellBounds height].
	"align accordingly"
	aSymbol _ (owner ifNil:[self]) cellPositioning.
	box _ box align: (box perform: aSymbol) with: (cellBounds perform: aSymbol).
	"and install new bounds"
	self bounds: box.! !


!AlignmentMorphBob1 methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:23'!
fullDrawOn: aCanvas

	| mask |

	super fullDrawOn: aCanvas.
	mask _ self valueOfProperty: #disabledMaskColor ifAbsent: [^self].
	aCanvas fillRectangle: self bounds color: mask.
! !


!B3DSceneMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:41'!
debugDraw
	self fullDrawOn: (Display getCanvas).
	Display forceToScreen: self bounds.! !

!B3DSceneMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:40'!
drawAcceleratedOn: aCanvas
	| myRect |
	myRect _ (self bounds: self bounds in: nil) intersect: (0 at 0 extent: DisplayScreen actualScreenSize).
	(myRenderer notNil and:[myR!
enderer isAccelerated]) ifFalse:[
		myRenderer ifNotNil:[myRenderer destroy].
		myRenderer _ nil.
	].
	myRenderer ifNotNil:[
		myRenderer _ myRenderer bufferRect: myRect.
	].
	myRenderer ifNil:[
		myRenderer _ B3DHardwareEngine newIn: myRect.
		myRenderer ifNil:[^self drawSimulatedOn: aCanvas].
	] ifNotNil:[
		myRenderer reset.
	].
	myRenderer viewportOffset: aCanvas origin.
	myRenderer clipRect: aCanvas clipRect.
	self renderOn: myRenderer.
	Display addExtraRegion: myRect for: self.! !


!BackgroundMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:05'!
drawOn: aCanvas
	"The tiling is solely determined by bounds, subBounds and offset.
	The extent of display is determined by bounds and the clipRect of the canvas."
	| start d subBnds |
	submorphs isEmpty ifTrue: [^ super drawOn: aCanvas].
	subBnds _ self subBounds.
	running ifFalse:
		[super drawOn: aCanvas.
		^ aCanvas fillRectangle: subBnds color: Color lightBlue].
	start _ subBnds topLeft + offset - self topLe!
ft - (1 at 1) \\ subBnds extent - subBnds extent + (1 at 1).
	d _ subBnds topLeft - self topLeft.
"Sensor redButtonPressed ifTrue: [self halt]."
	start x to: self width - 1 by: subBnds width do:
		[:x |
		start y to: self height - 1 by: subBnds height do:
			[:y | aCanvas translateBy: (x at y) - d clippingTo: self bounds
				during:[:tileCanvas| self drawSubmorphsOn: tileCanvas]]].! !

!BackgroundMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:04'!
fullDrawOn: aCanvas

	running ifFalse: [
		^aCanvas clipBy: (self bounds translateBy: aCanvas origin)
				during:[:clippedCanvas| super fullDrawOn: clippedCanvas]].
	aCanvas drawMorph: self.
! !


!BalloonRectangleMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:20'!
drawOn: aCanvas
	(color isKindOf: OrientedFillStyle) ifTrue:[
		color origin: self center.
		color direction: (self width * 0.7) @ 0.
		color normal: 0@(self height * 0.7).
	].
	(borderColor isKindOf: OrientedFillStyle) ifTrue:[
		borderColor origin: self to!
pLeft.
		borderColor direction: (self width) @ 0.
		borderColor normal: 0@(self height).
	].
	aCanvas asBalloonCanvas
		drawRectangle: (self bounds insetBy: borderWidth // 2)
		color: color
		borderWidth: borderWidth
		borderColor: borderColor.! !


!BouncingAtomsMorph methodsFor: 'stepping' stamp: 'jcg 7/1/2001 23:03'!
step
	"Bounce those atoms!!"

	| r bounces |
	super step.
	bounces _ 0.
	r _ self topLeft corner: self bottomRight - (8 at 8).
	self submorphsDo: [ :m |
		(m isMemberOf: AtomMorph) ifTrue: [
			(m bounceIn: r) ifTrue: [bounces _ bounces + 1]]].
	"compute a 'temperature' that is proportional to the number of bounces
	 divided by the circumference of the enclosing rectangle"
	self updateTemperature: (10000.0 * bounces) / (r width + r height).
	transmitInfection ifTrue: [self transmitInfection].
! !

!BouncingAtomsMorph methodsFor: 'other' stamp: 'jcg 7/1/2001 23:03'!
addAtoms: n
	"Add a bunch of new atoms."

	| a |
	n timesRepeat: [
		a _ AtomMorph new.
		a random!
PositionIn: self bounds maxVelocity: 10.
		self addMorph: a].
	self stopStepping.
! !

!BouncingAtomsMorph methodsFor: 'other' stamp: 'jcg 7/1/2001 23:04'!
invalidRect: damageRect from: aMorph
	"Try setting 'quickRedraw' to true. This invalidates the entire morph, whose bounds typically subsume all it's submorphs. (However, this code checks that assumption and passes through any damage reports for out-of-bounds submorphs. Note that atoms with super-high velocities do occaisionally shoot through the walls!!) An additional optimization is to only submit only damage report per display cycle by using the damageReported flag, which is reset to false when the morph is drawn."

	| quickRedraw |
	quickRedraw _ true.  "false gives the original invalidRect: behavior"
	(quickRedraw and:
	 [(self topLeft <= damageRect topLeft) and:
	 [damageRect bottomRight <= self bottomRight]]) ifTrue: [
		"can use quick redraw if damage is within my bounds"
		damageReported ifFalse: [super invalidRec!
t: self bounds from: self].  "just report once"
		damageReported _ true.
	] ifFalse: [super invalidRect: damageRect from: aMorph].  "ordinary damage report"! !


!CRLineMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:38'!
getPoint: aNumber
	aNumber = 1 ifTrue: [^ self bottomLeft + (1 at -1)].
	aNumber = 2 ifTrue: [^ self bottomRight + (-1 at -1)].
	aNumber = 3 ifTrue: [^ self topRight + (-1 at 1)].
	aNumber = 4 ifTrue: [^ self topLeft + (1 at 1)].	! !

!CRLineMorph methodsFor: 'accessing' stamp: 'jcg 7/1/2001 22:23'!
privateSetStart: startPoint end: endPoint
	| xDiff yDiff |
	xDiff _ endPoint x - startPoint x.
	yDiff _ endPoint y - startPoint y.
	quadrant _ (yDiff <= 0 ifTrue: [xDiff >= 0 ifTrue: [1] ifFalse: [2]] ifFalse: [xDiff >= 0 ifTrue: [4] ifFalse: [3]]).
	self privateBounds:
		(((endPoint x min: startPoint x) - 1) @ ((endPoint y min: startPoint y) - 1) corner:
			((endPoint x max: startPoint x) + 1) @ ((endPoint y max: startPoint y) + 1)).! !


!CRStrokeMorph methodsFor: 'ad!
ding' stamp: 'jcg 12/31/2001 16:06'!
addPoint: aPoint
	"We can save some time if we don't open this morph before we know the first point."

	| r |
	(points size > 0 and: [points last = aPoint]) ifTrue: [^self].
	points add: aPoint.
	r := points last extent: 1 at 1.
	self privateBounds: (points size = 1 ifTrue: [r] ifFalse: [self bounds merge: r]).
	points size = 1
		ifTrue:
			[self openInWorld]
		ifFalse:
			[World canvas 
				line: (points at: (points size-1 max: 1))
				to: points last
				color: self color].! !


!CategoryViewer methodsFor: 'header pane' stamp: 'jcg 7/1/2001 23:22'!
addHeaderMorph
	"Add the header at the top of the viewer, with a control for choosing the category, etc."

	| header aFont aButton wrpr |
	header _ AlignmentMorph newRow color: self color; wrapCentering: #center; cellPositioning: #leftCenter.
	aFont _ Preferences standardButtonFont.
	header addMorph: (aButton _ SimpleButtonMorph new label: 'O' font: aFont).
	aButton target: self;
			color:  Colo!
r tan;
			actionSelector: #delete;
			setBalloonText: 'remove this pane from the screen
don''t worry -- nothing will be lost!!.'.
	header addTransparentSpacerOfSize: 5 at 5.

	header addUpDownArrowsFor: self.
	(wrpr _ header submorphs last) submorphs second setBalloonText: 'previous category'.	
	wrpr submorphs first  setBalloonText: 'next category'.
	header beSticky.
	self addMorph: header.

	namePane _ RectangleMorph newSticky color: Color brown veryMuchLighter.
	namePane borderWidth: 0.
	aButton _ (StringButtonMorph contents: '-----' font: (StrikeFont familyName: #NewYork size: 12)) color: Color black.
	aButton target: self; arguments: Array new; actionSelector: #chooseCategory.
	aButton actWhen: #buttonDown.
	namePane addMorph: aButton.
	aButton position: namePane position.
	namePane align: namePane topLeft with: (self topLeft + (50 @ 0)).
	namePane setBalloonText: 'category (click here to choose a different one)'.

	header addMorphBack: namePane.
	(namePane isKindOf: Rectan!
gleMorph) ifTrue:
		[namePane addDropShadow.
		namePane shadowColor: Color gray].

	chosenCategorySymbol _ #basic! !


!EToyFridgeMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:24'!
drawOn: aCanvas

	| f cache |
	f _ self class fridgeForm ifNil: [^super drawOn: aCanvas].
	cache _ Form extent: self extent depth: aCanvas depth.
	f
		displayInterpolatedIn: cache boundingBox truncated
		on: cache.
	cache replaceColor: Color black withColor: Color transparent.
	aCanvas 
		translucentImage: cache
		at: self position.
! !


!EToyMultiChatMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:23'!
wantsDroppedMorph: aMorph event: evt

	(aMorph isKindOf: EToySenderMorph) ifFalse: [^false].
	(self bounds containsPoint: evt cursorPoint) ifFalse: [^false].
	^true.! !


!EllipseMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:16'!
containsPoint: aPoint

	| radius other delta xOverY |
	(self bounds containsPoint: aPoint) ifFalse: [^ false].  "quick!
 elimination"
	(self width = 1 or: [self height = 1])
		ifTrue: [^ true].  "Degenerate case -- code below fails by a bit"

	radius _ self height asFloat / 2.
	other _ self width asFloat / 2.
	delta _ aPoint - self topLeft - (other at radius).
	xOverY _ self width asFloat / self height asFloat.
	^ (delta x asFloat / xOverY) squared + delta y squared <= radius squared! !

!EllipseMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:16'!
drawOn: aCanvas 

	aCanvas isShadowDrawing
		ifTrue: [^ aCanvas fillOval: self bounds fillStyle: self fillStyle borderWidth: 0 borderColor: nil].
	aCanvas fillOval: self bounds fillStyle: self fillStyle borderWidth: borderWidth borderColor: borderColor.
! !


!EmbeddedWorldBorderMorph methodsFor: 'as yet unclassified' stamp: 'jcg 12/31/2001 15:21'!
extent: aPoint

	self extent = aPoint ifFalse: [
		self changed.
		self privateBounds: (self position extent: aPoint).
		self myWorldChanged.
	].
! !

!EmbeddedWorldBorderMorph methodsFor: 'a!
s yet unclassified' stamp: 'jcg 7/1/2001 23:23'!
myWorldChanged
	| trans |
	trans _ self myTransformation.
	self changed.
	self layoutChanged.
	trans ifNotNil:[
		trans extentFromParent: self innerBounds extent.
		self privateBounds: (self topLeft extent: trans extent + (borderWidth * 2)).
	].
	self changed.
! !

!EmbeddedWorldBorderMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:23'!
toggleZoom

	self bounds: (
		self bounds area > (Display boundingBox area * 0.9) ifTrue: [
			Display extent // 4 extent: Display extent // 2.
		] ifFalse: [
			Display boundingBox
		]
	)

! !


!EnvelopeEditorMorph methodsFor: 'construction' stamp: 'jcg 7/1/2001 23:19'!
addKeyboard
	keyboard _ PianoKeyboardMorph new soundPrototype: sound.
	keyboard align: keyboard bounds bottomCenter with: self bounds bottomCenter - (0 at 4).
	self addMorph: keyboard! !

!EnvelopeEditorMorph methodsFor: 'stepping' stamp: 'jcg 7/1/2001 23:18'!
step
	| mouseDown hand |
	hand _ self world firstHand.!

	(self bounds containsPoint: hand position) ifFalse: [^ self].

	mouseDown _ hand lastEvent redButtonPressed.
	mouseDown not & prevMouseDown ifTrue:
		["Mouse just went up"
		limitXs = (limits collect: [:i | (envelope points at: i) x]) ifFalse:
			["Redisplay after changing limits"
			self editEnvelope: envelope]].
	prevMouseDown _ mouseDown! !


!EtoyLoginMorph methodsFor: 'initialize' stamp: 'jcg 12/31/2001 16:04'!
initialize
	| fs |
	super initialize.
	self beSticky.
	fs _ GradientFillStyle ramp: {0.0 -> (Color r: 0.5 g: 0.5 b: 1.0). 1.0 -> (Color r: 0.8 g: 0.8 b: 1.0) }.
	self vResizing: #shrinkWrap.
	self hResizing: #shrinkWrap.
	color _ Color paleYellow.
	borderWidth _ 8.
	borderColor _ color darker.
	self layoutInset: 4.
	self useRoundedCorners.
	self rebuild.
	fs origin: self position.
	fs direction: 0 at self fullBounds height.
	self fillStyle: fs.! !


!GraphMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:21'!
drawOn: aCanvas

	| c |
	cachedForm = nil ifTrue:  [
!
		c _ Display defaultCanvasClass extent: self extent.
		c translateBy: self position negated
			during:[:tempCanvas| self drawDataOn: tempCanvas].
		cachedForm _ c form].
	aCanvas cache: self bounds
			using: cachedForm
			during:[:cachingCanvas| self drawDataOn: cachingCanvas].
	self drawCursorOn: aCanvas.
! !

!GraphMorph methodsFor: 'events' stamp: 'jcg 7/1/2001 23:21'!
mouseMove: evt

	| x w |
	x _ evt cursorPoint x - (self left + borderWidth).
	w _ self width - (2 * borderWidth).

	self changed.
	x < 0 ifTrue: [
		cursor _ startIndex + (3 * x).
		cursor _ (cursor max: 1) min: data size.
		^ self startIndex: cursor].
	x > w ifTrue: [
		cursor _ startIndex + w + (3 * (x - w)).
		cursor _ (cursor max: 1) min: data size.
		^ self startIndex: cursor - w].

	cursor _ ((startIndex + x) max: 1) min: data size.
! !

!GraphMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:21'!
drawDataOn: aCanvas

	| yScale baseLine x start end value left top bottom right |
	super drawOn: aCanv!
as.

	data isEmpty ifTrue: [^ self].
	maxVal = minVal ifTrue: [
		yScale _ 1.
	] ifFalse: [
		yScale _ (self height - (2 * borderWidth)) asFloat / (maxVal - minVal)].
	baseLine _ self bottom - borderWidth + (minVal * yScale) truncated.
	left _ top _ 0. right _ 10. bottom _ 0.
	x _ self left + borderWidth.
	start _ (startIndex asInteger max: 1) min: data size.
	end _ (start + self width) min: data size.
	start to: end do: [:i |
		left _ x truncated. right _ x + 1.
		right > (self right - borderWidth) ifTrue: [^ self].
		value _ (data at: i) asFloat.
		value >= 0.0 ifTrue: [
			top _ baseLine - (yScale * value) truncated.
			bottom _ baseLine.
		] ifFalse: [
			top _ baseLine.
			bottom _ baseLine - (yScale * value) truncated].
		aCanvas fillRectangle: (left at top corner: right at bottom) color: dataColor.
		x _ x + 1].
! !

!GraphMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:21'!
keepIndexInView: index

	| w newStart |
	w _ self width - (2 * borderWidth).
	index < startIndex!
 ifTrue: [
		newStart _ index - w + 1.
		^ self startIndex: (newStart max: 1)].
	index > (startIndex + w) ifTrue: [
		^ self startIndex: (index min: data size)].
! !


!HaloMorph methodsFor: 'events' stamp: 'jcg 7/1/2001 23:32'!
containsPoint: aPoint event: anEvent
	"Blue buttons are handled by the halo"
	(anEvent isMouse and:[anEvent isMouseDown and:[anEvent blueButtonPressed]])
		ifFalse:[^super containsPoint: aPoint event: anEvent].
	^ self bounds containsPoint: anEvent position! !


!HandMorph methodsFor: 'accessing' stamp: 'jcg 7/1/2001 23:38'!
position

	^temporaryCursor
		ifNil: [self bounds topLeft]
		ifNotNil: [self bounds topLeft - temporaryCursorOffset]! !

!HandMorph methodsFor: 'cursor' stamp: 'jcg 12/31/2001 15:23'!
showTemporaryCursor: cursorOrNil hotSpotOffset: hotSpotOffset
	"Set the temporary cursor to the given Form.
	If the argument is nil, revert to the normal hardware cursor."

	self changed.
	temporaryCursorOffset ifNotNil:[
		self privateBounds: (self!
 bounds translateBy: temporaryCursorOffset negated).
	].
	cursorOrNil == nil
		ifTrue: [temporaryCursor _ temporaryCursorOffset _ nil]
		ifFalse: [temporaryCursor _ cursorOrNil asCursorForm.
				temporaryCursorOffset _ temporaryCursor offset - hotSpotOffset].
	self privateBounds: self cursorBounds.
	self 
		userInitials: userInitials andPicture: (self userPicture);
		layoutChanged;
		changed
! !

!HandMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:38'!
drawOn: aCanvas
	| userPic |
	"Draw the hand itself (i.e., the cursor)."

	temporaryCursor == nil
		ifTrue: [aCanvas paintImage: NormalCursor at: self topLeft]
		ifFalse: [aCanvas paintImage: temporaryCursor at: self topLeft].
	self hasUserInformation ifTrue: [
		aCanvas 
			text: userInitials
			at: (self cursorBounds topRight + (0 at 4))
			font: nil
			color: color.
		(userPic _ self userPicture) ifNotNil: [
			aCanvas paintImage: userPic at: (self cursorBounds topRight + (0 at 24))
		].
	].
! !


!HeadingMorph methodsFor: '!
events' stamp: 'jcg 7/1/2001 23:18'!
mouseMove: evt

	| v |
	self changed.
	v _ evt cursorPoint - self center.
	degrees _ v theta radiansToDegrees.
	magnitude _ (v r asFloat / (self width asFloat / 2.0)) min: 1.0.
! !


!ImageMorph methodsFor: 'drawing' stamp: 'jcg 12/31/2001 15:24'!
drawOn: aCanvas

	self isOpaque
		ifTrue:[aCanvas drawImage: image at: self position]
		ifFalse:[aCanvas paintImage: image at: self position]! !

!ImageMorph methodsFor: 'drawing' stamp: 'jcg 12/31/2001 15:24'!
drawPostscriptOn: aCanvas

	| top f2 c2 clrs |

	clrs _ image colorsUsed.
	(clrs includes: Color transparent) 
		ifFalse: [^super drawPostscriptOn: aCanvas].		"no need for this, then"

	top _ aCanvas topLevelMorph.
	f2 _ Form extent: self extent depth: image depth.
	c2 _ f2 getCanvas.
	c2 fillColor: Color white.
	c2 translateBy: self position negated clippingTo: f2 boundingBox during: [ :c |
		top fullDrawOn: c
	].
	aCanvas paintImage: f2 at: self position! !


!InterimSoundMorph methodsF!
or: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:19'!
addGraphic

	graphic _ SketchMorph withForm: self speakerGraphic.
	graphic position: self center - (graphic extent // 2).
	self addMorph: graphic.
! !


!InternalThreadNavigationMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:24'!
positionAppropriately

	| others otherRects overlaps |

	(self ownerThatIsA: HandMorph) ifNotNil: [^self].
	others _ self world submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
	otherRects _ others collect: [ :each | each bounds].
	self align: self fullBounds bottomRight with: self world bottomRight.
	self setProperty: #previousWorldBounds toValue: self world bounds.

	[
		overlaps _ false.
		otherRects do: [ :r |
			(r intersects: self bounds) ifTrue: [overlaps _ true. self bottom: r top].
		].
		self top < self world top ifTrue: [
			self bottom: self world bottom.
			self right: self left - 1.
		].
		overlaps
	] whileTrue.! !


!InterpolatingImageMo!
rph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:41'!
extent: extentPoint
	self extent = extentPoint ifFalse: [
		cachedImage _ nil.
		self changed.
		self privateBounds: (self topLeft extent: extentPoint).
		self layoutChanged.
		self changed].
! !


!MPEGDisplayMorph methodsFor: 'drawing' stamp: 'jcg 12/31/2001 15:28'!
drawOn: aCanvas
	"Draw the current frame image, if there is one. Otherwise, fill screen with gray."

	frameBuffer
		ifNil: [aCanvas fillRectangle: self bounds color: (Color gray: 0.75)]
		ifNotNil: [
			self extent = frameBuffer extent
				ifTrue: [aCanvas drawImage: frameBuffer at: self position]
				ifFalse: [self drawScaledOn: aCanvas]].
! !

!MPEGDisplayMorph methodsFor: 'drawing' stamp: 'jcg 12/31/2001 16:07'!
drawScaledOn: aCanvas
	"Draw the current frame image scaled to my bounds."

	| outForm destPoint warpBlt |
	((aCanvas isKindOf: FormCanvas) and: [aCanvas form = Display])
		ifTrue: [  "optimization: when canvas is the Display, Warpblt directly t!
o it"
			outForm _ Display.
			destPoint _ self position + aCanvas origin]
		ifFalse: [
			outForm _ Form extent: self extent depth: aCanvas form depth.
			destPoint _ 0 at 0].
	warpBlt _ (WarpBlt current toForm: outForm)
		sourceForm: frameBuffer;
		colorMap: (frameBuffer colormapIfNeededForDepth: outForm depth);
		cellSize: 1;  "installs a new colormap if cellSize > 1"
		combinationRule: Form over.
	outForm == Display ifTrue: [warpBlt clipRect: aCanvas clipRect].
	warpBlt
		copyQuad: frameBuffer boundingBox innerCorners
		toRect: (destPoint extent: self extent).
	outForm == Display ifFalse: [
		aCanvas drawImage: outForm at: self position].

! !


!MatrixTransformMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 12:12'!
computeBounds
	| subBounds box |
	(submorphs isNil or:[submorphs isEmpty]) ifTrue:[^self].
	box _ nil.
	submorphs do:[:m|
		subBounds _ self transform localBoundsToGlobal: m bounds.
		box 
			ifNil:[box _ subBounds]
			ifNotNil:[box _ box quickMerge: subBounds!
].
	].
	box ifNil:[box _ 0 at 0 corner: 20 at 20].
	fullBounds _ self privateBounds: box! !

!MatrixTransformMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:35'!
containsPoint: aPoint
	self visible ifFalse:[^false].
	(self bounds containsPoint: aPoint) ifFalse: [^ false].
	self hasSubmorphs
		ifTrue: [self submorphsDo: 
					[:m | (m fullContainsPoint: (self transform globalPointToLocal: aPoint))
							ifTrue: [^ true]].
				^ false]
		ifFalse: [^ true]! !

!MatrixTransformMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:36'!
handleBoundsChange: aBlock
	| oldBounds newBounds |
	oldBounds _ self bounds.
	aBlock value.
	newBounds _ self bounds.
	self boundsChangedFrom: oldBounds to: newBounds.! !

!MatrixTransformMorph methodsFor: 'geometry' stamp: 'jcg 12/31/2001 15:29'!
rotationCenter
	| pt |
	pt _ self transform localPointToGlobal: super rotationCenter.
	^ pt - self position / self extent asFloatPoint! !

!MatrixTransformMorph methodsFor: 'geometry' stamp: 'jcg 12/31/20!
01 15:30'!
rotationCenter: aPoint
	super rotationCenter: (self transform globalPointToLocal: self position + (self extent * aPoint))! !


!FlashShapeMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:08'!
computeBounds

	self privateBounds: (self transform localBoundsToGlobal: (shape bounds)).! !


!FlashSpriteMorph methodsFor: 'stepping' stamp: 'jcg 7/1/2001 22:09'!
stepToFrame: frame
	"Step to the given frame"
	| fullRect postDamage lastVisible resortNeeded |
	frame = frameNumber ifTrue:[^self].
	frame > loadedFrames ifTrue:[^self].
	postDamage _ damageRecorder isNil.
	postDamage ifTrue:[damageRecorder _ FlashDamageRecorder new].
	lastVisible _ nil.
	resortNeeded _ false.
	submorphs do:[:m|
		(m isFlashMorph and:[m isFlashCharacter]) ifTrue:[
			m stepToFrame: frame.
			m visible ifTrue:[
				(lastVisible notNil and:[lastVisible depth < m depth])
					ifTrue:[resortNeeded _ true].
				lastVisible _ m.
				(self bounds containsRect: m bounds) ifFalse: [
					self privateB!
ounds: (self bounds merge: m bounds)].
			].
		].
	].
	resortNeeded ifTrue:[submorphs _ submorphs sortBy:[:m1 :m2| m1 depth > m2 depth]].
	frameNumber _ frame.
	playing ifTrue:[
		self playSoundsAt: frame.
		self executeActionsAt: frame.
	].
	(postDamage and:[owner notNil]) ifTrue:[
		damageRecorder updateIsNeeded ifTrue:[
			"fullRect _ damageRecorder fullDamageRect.
			fullRect _ (self transform localBoundsToGlobal: fullRect)."
			fullRect _ self bounds.
			owner invalidRect: (fullRect insetBy: -1) from: self.
		].
	].
	postDamage ifTrue:[
		damageRecorder _ nil].! !


!FlashPlayerMorph methodsFor: 'initialize' stamp: 'jcg 9/4/2001 10:02'!
initialize
	super initialize.
	color _ Color white.
	self loopFrames: true.
	localBounds _ self bounds.
	activationKeys _ #().
	activeMorphs _ SortedCollection new: 50.
	activeMorphs sortBlock:[:m1 :m2| m1 depth > m2 depth].
	progressValue _ ValueHolder new.
	progressValue contents: 0.0.
	self defaultAALevel: 2.
	self deferred: true.! !
!

!FlashPlayerMorph methodsFor: 'initialize' stamp: 'jcg 7/1/2001 22:36'!
openInMVC
	| window extent |
	self localBounds: localBounds.
	extent _ self extent.
	window _ FlashPlayerWindow labelled:'Flash Player'.
	window model: (FlashPlayerModel player: self).
	window addMorph: self frame:(0 at 0 corner: 1 at 1).
	window openInMVCExtent: extent! !

!FlashPlayerMorph methodsFor: 'initialize' stamp: 'jcg 7/1/2001 22:37'!
openInWorld
	| window extent |
	self localBounds: localBounds.
	extent _ self extent.
	window _ FlashPlayerWindow labelled:'Flash Player'.
	window model: (FlashPlayerModel player: self).
	window addMorph: self frame:(0 at 0 corner: 1 at 1).
	window openInWorldExtent: extent! !

!FlashPlayerMorph methodsFor: 'accessing' stamp: 'jcg 7/1/2001 22:38'!
localBounds: newBounds

	localBounds _ newBounds.
	self privateBounds: (self position extent: newBounds extent // 20).
	transform _ MatrixTransform2x3 
					transformFromLocal: newBounds 
					toGlobal: self bounds! !

!FlashPlayer!
Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:38'!
fullBounds
	"The player clips its children"
	^ self bounds! !

!FlashPlayerMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:38'!
fullContainsPoint: pt
	"The player clips its children"
	(self bounds containsPoint: pt) ifFalse:[^false].
	^super fullContainsPoint: pt! !


!MenuLineMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:49'!
drawOn: aCanvas
	| pref |
	aCanvas
		fillRectangle: (self topLeft corner: self bounds rightCenter)
		color: ((pref _ Preferences menuColorFromWorld)
					ifTrue:
						[owner color darker]
					ifFalse:
						[Preferences menuLineUpperColor]).
	aCanvas
		fillRectangle: (self bounds leftCenter corner: self bottomRight)
		color: (pref
					ifTrue:
						[owner color lighter]
					ifFalse:
						[Preferences menuLineLowerColor])! !


!Morph class methodsFor: 'instance creation' stamp: 'jcg 7/1/2001 12:47'!
newBounds: bounds
	| newMorph |

	"Changed because 'privateBounds:' now returns 'b!
ounds' rather than 'self'"

	(newMorph _ self new) privateBounds: bounds.
	^ newMorph
! !

!Morph class methodsFor: 'instance creation' stamp: 'jcg 7/1/2001 12:06'!
newBounds: bounds color: color
	"Changed to allow 'privateBounds:' to return the new value of 'bounds' rather than 'self'"

	^ (self newBounds: bounds) privateColor: color
! !


!MorphicModel methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:16'!
recomputeBounds

	| bnds |
	bnds _ submorphs first bounds.
	self privateBounds: (bnds origin corner: bnds corner). "copy it!!"
	self privateBounds: (self fullBounds).
! !

!MorphicModel methodsFor: 'printing' stamp: 'jcg 7/1/2001 23:05'!
initString

	^ String streamContents:
		[:s | s nextPutAll: self class name;
			nextPutAll: ' newBounds: (';
			print: self bounds;
			nextPutAll: ') model: self slotName: ';
			print: slotName]! !


!NetworkTerminalMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:22'!
initialize
	super initialize.
	backgroundForm _ (
		(StringMor!
ph contents: '......' font: (TextStyle default fontOfSize: 24))
			color: Color white
	) imageForm.
	self privateBounds: backgroundForm boundingBox.
! !

!NetworkTerminalMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:32'!
drawOn: aCanvas

	backgroundForm ifNotNil: [
		aCanvas clipBy: self bounds during: [ :c |
			c drawImage: backgroundForm at: self topLeft
		].
	].
! !

!NetworkTerminalMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:32'!
forceToFront: aRegion
	| highQuality |
	"force the given region from the drawing form onto the background form"

	highQuality _ false.		"highQuality is slower"

	self updateBackgroundForm.
	backgroundForm
		copy: aRegion
		from: aRegion topLeft
		in: decoder drawingForm
		rule: Form over.
	self invalidRect: (
		highQuality ifTrue: [
			self bounds
		] ifFalse: [
			(aRegion expandBy: 4) translateBy: self topLeft	"try to remove gribblys"
		]
	)
! !

!NetworkTerminalMorph methodsFor: 'event handling' stamp: 'jcg 7/1/2001 23:32'!
send!
Event: evt

	self sendEventAsIs: (evt translatedBy: self topLeft negated).! !


!NullTerminalMorph methodsFor: 'as yet unclassified' stamp: 'jcg 12/31/2001 15:34'!
extent: newExtent

	| aPoint |
	aPoint _ 50 at 50.
	self extent = aPoint ifFalse: [
		self changed.
		self privateBounds: (self position extent: aPoint).
		self layoutChanged.
		self changed
	].
	eventEncoder sendViewExtent: newExtent! !


!PaintBoxMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:41'!
init3
	"Just a record of how we loaded in the latest paintbox button images"
| bb rect lay pic16Bit aa blt on thin |
self loadoffImage: 'etoy_default.gif'.
self allMorphsDo: [:button |
	(button isKindOf: ThreePhaseButtonMorph) 
		ifTrue: [button offImage: nil]
		ifFalse: [button position: button position + (100 at 0)]].
(bb _ self submorphNamed: #keep:) position: bb position + (100 at 0).
(bb _ self submorphNamed: #toss:) position: bb position + (100 at 0).
(bb _ self submorphNamed: #undo:) position: bb position + (100!
@0).
"Transparent is (Color r: 1.0 g: 0 b: 1.0)"

self moveButtons.
self loadOnImage: 'etoy_in.gif'.
AllOnImage _ nil.	'save space'.	
self loadPressedImage: 'etoy_in.gif'.
AllPressedImage _ nil.	'save space'.
self loadCursors.

"position the stamp buttons"
stampHolder stampButtons owner last delete.
stampHolder pickupButtons last delete.
stampHolder stampButtons: (stampHolder stampButtons copyFrom: 1 to: 3).
stampHolder pickupButtons: (stampHolder pickupButtons copyFrom: 1 to: 3).
"| rect |"
stampHolder pickupButtons do: [:button |
		"PopUpMenu notify: 'Rectangle for ',sel."
		rect _ Rectangle fromUser.
		button bounds: rect.	"image is nil"
		].
"| rect lay |"
stampHolder clear.
stampHolder stampButtons do: [:button |
		button offImage: nil; pressedImage: nil.
		lay _ button owner.
		"PopUpMenu notify: 'Rectangle for ',sel."
		rect _ Rectangle fromUser.
		button image: (Form fromDisplay: (rect insetBy: 2)).
		lay borderWidth: 2.
		lay bounds: rect.	"image is nil"
		].
"| pic!
16Bit blt aa on |"
	pic16Bit "really 8" _ GIFReadWriter formFromFileNamed: 'etoy_in.gif'.
	aa _ Form extent: OriginalBounds extent depth: 8.
	blt _ BitBlt current toForm: aa.
	blt sourceForm: pic16Bit; combinationRule: Form over;
		sourceRect: OriginalBounds; destOrigin: 0 at 0; copyBits.
	"Collect all the images for the buttons in the on state"
	stampHolder pickupButtons do: [:button |
			on _ ColorForm extent: button extent depth: 8.
					 on colors: pic16Bit colors.
			on copy: (0 at 0 extent: button extent)
				from: (button topLeft - self topLeft) in: aa rule: Form over.
			button image: on; pressedImage: on; offImage: nil.
			].
	self invalidRect: self bounds.

((self submorphNamed: #erase:) arguments at: 3) offset: (12 at 35).
((self submorphNamed: #eyedropper:) arguments at: 3) offset: (0 at 0).
((self submorphNamed: #fill:) arguments at: 3) offset: (10 at 44).
((self submorphNamed: #paint:) arguments at: 3) offset: (3 at 3). "unused"
((self submorphNamed: #rect:) arguments at: 3) off!
set: (6 at 17).
((self submorphNamed: #ellipse:) arguments at: 3) offset: (5 at 4).
((self submorphNamed: #polygon:) arguments at: 3) offset: (5 at 4).
((self submorphNamed: #line:) arguments at: 3) offset: (5 at 17).
((self submorphNamed: #star:) arguments at: 3) offset: (2 at 5).
thumbnail delete.
thumbnail _ nil.
(submorphs select: [:e | e class == RectangleMorph]) first bounds: 
	Rectangle fromUser.
(submorphs select: [:e | e class == RectangleMorph]) first borderWidth: 1; borderColor: Color black.
"| thin |"
	submorphs do: [:ss | ss class == ImageMorph ifTrue: [thin _ ss "first"]].
colorMemoryThin _ thin.
! !

!PaintBoxMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:43'!
init4
	"Just a record of how Ted loaded in the paintbox button images, Feb 98"
| bb im pp newImage pic24Bit picNewBit blt |

"self loadoffImage: 'roundedPalette3.bmp'."
pic24Bit _ GIFReadWriter formFromServerFile: 'updates/137roundedPalette3.bmp'.
picNewBit _ Form extent: pic24Bit extent depth: 16.
pic24Bit!
 displayOn: picNewBit.
OriginalBounds _ picNewBit boundingBox.
AllOffImage _ Form extent: OriginalBounds extent depth: 16.
blt _ BitBlt current toForm: AllOffImage.
blt sourceForm: picNewBit; combinationRule: Form over;
		sourceRect: OriginalBounds; destOrigin: 0 at 0; copyBits.

AllOffImage mapColor: Color transparent to: Color black.
self image: AllOffImage.
self invalidRect: self bounds.

self submorphsDo: [:button | button position: button position + (10 at 10)].
(im _ submorphs at: 28) class == ImageMorph ifTrue: [
	im position: im position + (2 at 0)].	"color picker"
"exercise it once"

(bb _ self submorphNamed: #keep:) position: bb position + (0 at 25).
(bb _ self submorphNamed: #toss:) position: bb position + (0 at 25).
(bb _ self submorphNamed: #undo:) position: bb position + (0 at -25).
(bb _ self submorphNamed: #clear:) position: bb position + (0 at -25).
(bb _ self submorphNamed: #undo:) position: bb position + (0 at -69).
(bb _ self submorphNamed: #clear:) position: bb position + (0 at -6!
9).
self submorphsDo: [:button | 
	button class == AlignmentMorph ifTrue: [
		button position: button position + (0 at 25)].
	(button printString includesSubString: 'stamp:') ifTrue: [
		button position: button position + (0 at 25)]].
(bb _ self submorphNamed: #prevStamp:) position: bb position + (0 at 25).
(bb _ self submorphNamed: #nextStamp:) position: bb position + (0 at 25).

bb _ self submorphNamed: #keep:.
newImage _ bb pressedImage copy: (0 at 4 corner: (bb pressedImage boundingBox extent)).
bb onImage: newImage.  bb pressedImage: newImage.  bb extent: newImage extent.
bb position: bb position + (4 at 1).

pp _ (bb _ self submorphNamed: #toss:) pressedImage.
newImage _ pp copy: (0 at 4 corner: (bb pressedImage extent - (3 at 0))).
bb onImage: newImage.  bb pressedImage: newImage.  
bb extent: newImage extent.
bb position: bb position + (3 at 1).

pp _ (bb _ self submorphNamed: #undo:) pressedImage.
newImage _ pp copy: (0 at 0 corner: (bb pressedImage extent - (3 at 5))).
bb onImage: newImage.  bb pr!
essedImage: newImage.  
bb extent: newImage extent.
bb position: bb position + (3 at -1).

pp _ (bb _ self submorphNamed: #clear:) pressedImage.
newImage _ pp copy: (0 at 0 corner: (bb pressedImage extent - (0 at 5))).
bb onImage: newImage.  bb pressedImage: newImage.  
bb extent: newImage extent.
bb position: bb position + (3 at -1).

pic24Bit _ GIFReadWriter formFromServerFile: 'updates/137pencil.bmp'.
picNewBit _ Form extent: pic24Bit extent depth: 16.
pic24Bit displayOn: picNewBit.
newImage _ picNewBit as8BitColorForm.
newImage transparentColor: (Color r: 0 g: 0 b: 0).
(bb _ self submorphNamed: #erase:) pressedImage: newImage; onImage: newImage;
	extent: newImage extent.

bb position: bb position + (-11 at -1).
! !

!PaintBoxMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:42'!
loadOnImage: fileName
	"Read in and convert the image for the paintBox with the buttons
on.  A .bmp 24-bit image.  For each button, cut that chunk out and save it."
	"	self loadOnImage: 'NoSh_on.bmp'.
!
		AllOnImage _ nil.	'save space'.	"

	| pic16Bit blt aa on type |
	type _ 'gif'.  "   gif or bmp  "
type = 'gif' ifTrue: [
	pic16Bit "really 8" _ GIFReadWriter formFromFileNamed: fileName.
	pic16Bit display.
	aa _ AllOnImage _ Form extent: OriginalBounds extent depth: 8.
	blt _ BitBlt current toForm: aa.
	blt sourceForm: pic16Bit; combinationRule: Form over;
		sourceRect: OriginalBounds; destOrigin: 0 at 0; copyBits.
	].
type = 'bmp' ifTrue: [
	pic16Bit _ (Form fromBMPFileNamed: fileName) asFormOfDepth: 16.
	pic16Bit display.
	aa _ AllOnImage _ Form extent: OriginalBounds extent depth: 16.
	blt _ BitBlt current toForm: aa.
	blt sourceForm: pic16Bit; combinationRule: Form over;
		sourceRect: OriginalBounds; destOrigin: 0 at 0; copyBits.
	aa mapColor: Color transparent to: Color black.
	].
	"Collect all the images for the buttons in the on state"
	self allMorphsDo: [:button |
		(button isKindOf: ThreePhaseButtonMorph) ifTrue: [
			type = 'gif' ifTrue: [on _ ColorForm extent: button !
extent depth: 8.
					 on colors: pic16Bit colors]
				ifFalse: [on _ Form extent: button extent depth: 16].
			on copy: (0 at 0 extent: button extent)
				from: (button topLeft - self topLeft) in: aa rule: Form over.
			button onImage: on]].
	self invalidRect: self bounds.

	! !

!PaintBoxMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:43'!
loadPressedImage: fileName
	"Read in and convert the image for the paintBox with the buttons
on.  A .bmp 24-bit image.  For each button, cut that chunk out and save it."
	"	self loadPressedImage: 'NoSh_on.bmp'.
		AllPressedImage _ nil.	'save space'.	"

	| pic16Bit blt aa on type |
	type _ 'gif'.  "   gif or bmp  "
type = 'gif' ifTrue: [
	pic16Bit "really 8" _ GIFReadWriter formFromFileNamed: fileName.
	pic16Bit display.
	aa _ AllPressedImage _ Form extent: OriginalBounds extent depth: 8.
	blt _ BitBlt current toForm: aa.
	blt sourceForm: pic16Bit; combinationRule: Form over;
		sourceRect: OriginalBounds; destOrigin: 0 at 0; copyBits!
.
	].
type = 'bmp' ifTrue: [
	pic16Bit _ (Form fromBMPFileNamed: fileName) asFormOfDepth: 16.
	pic16Bit display.
	aa _ AllPressedImage _ Form extent: OriginalBounds extent depth: 16.
	blt _ BitBlt current toForm: aa.
	blt sourceForm: pic16Bit; combinationRule: Form over;
		sourceRect: OriginalBounds; destOrigin: 0 at 0; copyBits.
	aa mapColor: Color transparent to: Color black.
	].
	"Collect all the images for the buttons in the on state"
	self allMorphsDo: [:button |
		(button isKindOf: ThreePhaseButtonMorph) ifTrue: [
			type = 'gif' ifTrue: [on _ ColorForm extent: button extent depth: 8.
					 on colors: pic16Bit colors]
				ifFalse: [on _ Form extent: button extent depth: 16].
			on copy: (0 at 0 extent: button extent)
				from: (button topLeft - self topLeft) in: aa rule: Form over.
			button pressedImage: on]].
	self invalidRect: self bounds.

	! !

!PaintBoxMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:42'!
loadoffImage: fileName
	"Read in and convert the back!
ground image for the paintBox.  All
buttons off.  A .bmp 24-bit image."
	"	Prototype loadoffImage: 'roundedPalette3.bmp'	"

	| pic16Bit blt type getBounds |
	type _ 'bmp'.  " gif or bmp  "
	getBounds _ 'fromPic'.	"fromUser = draw out rect of paintbox on image"
		"fromOB = just read in new bits, keep same size and place as last time."
		"fromPic = picture is just the PaintBox, use its bounds"
type = 'gif' ifTrue: [
	pic16Bit "really 8" _ GIFReadWriter formFromFileNamed: fileName.
	getBounds = 'fromUser' ifTrue: ["Just first time, collect the bounds"
			pic16Bit display.
			OriginalBounds _ Rectangle fromUser].
	getBounds = 'fromPic' ifTrue: [OriginalBounds _ pic16Bit boundingBox].
	].
		"Use OriginalBounds as it was last time".
type = 'bmp' ifTrue: [
	pic16Bit _ (Form fromBMPFileNamed: fileName) asFormOfDepth: 16.
	getBounds = 'fromUser' ifTrue: ["Just first time, collect the bounds"
			pic16Bit display.
			OriginalBounds _ Rectangle fromUser].
		"Use OriginalBounds as it was!
 last time".
	(getBounds = 'fromPic') ifTrue: [OriginalBounds _ pic16Bit boundingBox].
	AllOffImage _ Form extent: OriginalBounds extent depth: 16.
	].

type = 'gif' ifTrue: [
	AllOffImage _ ColorForm extent: OriginalBounds extent depth: 8.
	AllOffImage colors: pic16Bit colors].

	blt _ BitBlt current toForm: AllOffImage.
	blt sourceForm: pic16Bit; combinationRule: Form over;
		sourceRect: OriginalBounds; destOrigin: 0 at 0; copyBits.

type = 'bmp' ifTrue: [AllOffImage mapColor: Color transparent to: Color black].
	self image: AllOffImage.
	self invalidRect: self bounds.

	! !

!PaintBoxMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:42'!
noVeneer
	"For a palette with a background (off) image, clear that image.
But first, for each button, cut that chunk out and save it in the offImage
part."
	"	self noVeneer.
		AllOffImage _ nil.	'save space.  irreversible'.	"

	| aa on |
	AllOffImage ifNil: [AllOffImage _ image].
	aa _ AllOffImage.
	"Collect all the images for the b!
uttons in the on state"
	self allMorphsDo: [:button |
		(button isKindOf: ThreePhaseButtonMorph) ifTrue: [
			on _ Form extent: button extent depth: 16.
			on copy: (0 at 0 extent: button extent)
				from: (button topLeft - self topLeft) in:
aa rule: Form over.
			button offImage: on]].
	self image: (Form extent: AllOffImage extent depth: 1).
	self invalidRect: self bounds.


	! !

!PaintBoxMorph methodsFor: 'other' stamp: 'jcg 7/1/2001 22:41'!
maxBounds
	| rr |
	"fullBounds if all flop-out parts of the paintBox were showing."

	rr _ self bounds merge: colorMemory bounds.
	rr _ rr merge: (self submorphNamed: 'stamps') bounds.
	rr _ rr origin corner: rr corner + (0@ (self submorphNamed: 'shapes') height 
				+ 10 "what is showing of (self submorphNamed: #toggleShapes) height").
	^ rr! !

!PaintBoxMorph methodsFor: 'recent colors' stamp: 'jcg 12/31/2001 15:38'!
fixUpRecentColors
	| inner outer border box form newImage canvas morph |
	self fixUpColorPicker.
	recentColors _ WriteSt!
ream on: Array new.
	form _ image.
	newImage _ Form extent: form extent + (0 at 41) depth: form depth.
	form displayOn: newImage.
	newImage 
		copy: ((0@(form height-10)) extent: form width @ (newImage height - form height + 10)) 
		from: 0 @ (form height - (newImage height - form height + 10))
		in: form rule: Form over.
	canvas _ newImage getCanvas.
	canvas 
		line: 12@(form height-10) 
		to: 92@(form height-10) 
		width: 1 
		color: Color black.
	canvas _ canvas copyOffset: 12@(form height-9).

	inner _ (Color r: 0.677 g: 0.71 b: 0.968).
	outer _ inner darker darker.
	border _ (Color r: 0.194 g: 0.258 b: 0.194).
	0 to: 1 do:[:y|
		0 to: 3 do:[:x|
			box _ (x*20) @ (y*20) extent: 20 at 20.
			morph _ BorderedMorph new bounds: ((box insetBy: 1) translateBy: canvas origin + self position).
			morph 
				borderWidth: 1; 
				borderColor: border;
				color: Color white;
				on: #mouseDown send: #mouseDownRecent:with: to: self;
				on: #mouseMove send: #mouseStillDownRecent:with: to:!
 self;
				on: #mouseUp send: #mouseUpRecent:with: to: self.
			self addMorphFront: morph.
			recentColors nextPut: morph.
			canvas fillRectangle: box color: Color white.
			canvas frameRectangle: (box insetBy: 1) color: border.
			canvas frameRectangle: (box) color: inner.
			box _ box insetBy: 1.
			canvas line: box topRight to: box bottomRight width: 1 color: outer.
			canvas line: box bottomLeft to: box bottomRight width: 1 color: outer.
	]].
	recentColors _ recentColors contents.
	(RecentColors == nil or:[RecentColors size ~= recentColors size]) ifTrue:[
		RecentColors _ recentColors collect:[:each| each color].
	] ifFalse:[
		RecentColors keysAndValuesDo:[:idx :aColor| (recentColors at: idx) color: aColor].
	].
	self image: newImage.
	self toggleStamps.
	self toggleStamps.! !


!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'jcg 7/1/2001 23:29'!
positionNear: aPoint forExtent: anExtent adjustmentSuggestion: adjustmentPoint
	"Compute a plausible positioning for a!
dding a subpart of size anExtent, somewhere near aPoint, using adjustmentPoint as the unit of adjustment"

	| adjustedPosition |
	adjustedPosition _ aPoint.
	[((self morphsAt: (adjustedPosition + (anExtent // 2))) size > 1) and:  "that 1 is self here"
		[self bounds containsPoint: adjustedPosition]]
	whileTrue:
		[adjustedPosition _ adjustedPosition + adjustmentPoint].

	^ adjustedPosition! !

!PasteUpMorph methodsFor: 'menu & halo' stamp: 'jcg 7/1/2001 23:29'!
showApplicationView

	self transformToShow: (self valueOfProperty: #applicationViewBounds ifAbsent: [self bounds])
		! !

!PasteUpMorph methodsFor: 'menu & halo' stamp: 'jcg 7/1/2001 23:29'!
showFactoryView

	self transformToShow: (self valueOfProperty: #factoryViewBounds ifAbsent: [self bounds])
		! !

!PasteUpMorph methodsFor: 'menu & halo' stamp: 'jcg 7/1/2001 23:29'!
showFullView

	self transformToShow: self bounds
		! !

!PasteUpMorph methodsFor: 'project state' stamp: 'jcg 12/31/2001 15:41'!
viewBox: newViewBox
!
	"I am now displayed within newViewBox; react."

	(self viewBox == nil or: [self viewBox extent ~= newViewBox extent]) ifTrue: [
		worldState canvas: nil].

	worldState viewBox: newViewBox.
	super position: newViewBox topLeft.
	fullBounds _ (self privateBounds: newViewBox).

	"Paragraph problem workaround; clear selections to avoid screen droppings."
	self flag: #arNote.             "Probably unnecessary"
	worldState handsDo: [:hand | hand releaseKeyboardFocus].
	self fullRepaintNeeded! !

!PasteUpMorph methodsFor: 'world state' stamp: 'jcg 7/1/2001 23:27'!
addMorph: aMorph centeredNear: aPoint
	"Add the given morph to this world, attempting to keep its center as close to the given point possible while also keeping the it entirely within the bounds of this world."

	| trialRect delta |
	trialRect _ Rectangle center: aPoint extent: aMorph fullBounds extent.
	delta _ trialRect amountToTranslateWithin: self bounds.
	aMorph position: trialRect origin + delta.
	self addMorph: aMo!
rph.
! !

!PasteUpMorph methodsFor: 'world state' stamp: 'jcg 7/1/2001 23:29'!
extent: aPoint

	super extent: aPoint.
	worldState ifNotNil: [
		worldState viewBox ifNotNil: [
			worldState canvas: nil.
			worldState viewBox: self bounds
		].
	].! !

!PasteUpMorph methodsFor: 'world state' stamp: 'jcg 7/1/2001 23:29'!
fullContainsPoint: pt
	"The world clips its children"

	worldState ifNil: [^super fullContainsPoint: pt].
	^ self bounds containsPoint: pt

! !

!PasteUpMorph methodsFor: 'world state' stamp: 'jcg 7/1/2001 23:29'!
installAsActiveSubprojectIn: enclosingWorld at: newBounds titled: aString

	| window howToOpen tm boundsForWorld |

	howToOpen _ self embeddedProjectDisplayMode.	
				"#scaled may be the only one that works at the moment"

	submorphs do: [:ss | ss owner == nil ifTrue: [ss privateOwner: self]].
		"Transcript that was in outPointers and then got deleted."

	boundsForWorld _ howToOpen == #naked ifTrue: [newBounds] ifFalse: [self bounds].
	worldState canva!
s: nil.
	worldState viewBox: boundsForWorld.

	self bounds: boundsForWorld.

	"self viewBox: Display boundingBox."
	"worldState handsDo: [:h | h initForEvents]."

	self installFlaps.

	"SystemWindow noteTopWindowIn: self."
	"self displayWorldSafely."

	howToOpen == #naked ifTrue: [
		enclosingWorld addMorphFront: self.
	].
	howToOpen == #window ifTrue: [
		window _ (NewWorldWindow labelled: aString) model: self.
		window addMorph: self frame: (0 at 0 extent: 1.0 at 1.0).
		window openInWorld: enclosingWorld.
	].
	howToOpen == #frame ifTrue: [
		window _ AlignmentMorphBob1 new
			minWidth: 100;
			minHeight: 100;
			borderWidth: 8;
			borderColor: Color green;
			bounds: newBounds.
		window addMorph: self.
		window openInWorld: enclosingWorld.
	].
	howToOpen == #scaled ifTrue: [
		self position: 0 at 0.
		window _ EmbeddedWorldBorderMorph new
			minWidth: 100;
			minHeight: 100;
			borderWidth: 8;
			borderColor: Color green;
			bounds: newBounds.
		tm _ BOBTransformationMorph new.
		!
window addMorph: tm.
		tm addMorph: self.
		window openInWorld: enclosingWorld.
		tm changeWorldBoundsToShow: self bounds.
		self arrangeToStartSteppingIn: enclosingWorld.
		"tm scale: (tm width / self width min: tm height / self height) asFloat."
	].
! !

!PasteUpMorph methodsFor: 'world state' stamp: 'jcg 7/1/2001 23:29'!
optimumExtentFromAuthor

	| opt |
	^self 
		valueOfProperty: #optimumExtentFromAuthor 
		ifAbsent: [
			opt _ self extent.
			self setProperty: #optimumExtentFromAuthor toValue: opt.
			^opt
		]

! !

!PasteUpMorph methodsFor: 'world state' stamp: 'jcg 7/1/2001 23:30'!
paintArea
	"What rectangle should the user be allowed to create a new painting in??  An area beside the paintBox.  Allow playArea to override with its own bounds!!  "

	| playfield paintBoxBounds |
	playfield _ self submorphNamed: 'playfield' ifNone: [nil].
	playfield ifNotNil: [^ playfield bounds].

	paintBoxBounds _ self paintBox bounds.
	self firstHand targetOffset x < paintBoxBounds cen!
ter x
		ifTrue: [^ self topLeft corner: paintBoxBounds left at self bottom]   "paint on left side"
		ifFalse: [^ paintBoxBounds right at self top corner: self bottomRight].  "paint on right side"
! !

!PasteUpMorph methodsFor: 'world state' stamp: 'jcg 7/1/2001 23:30'!
privateMoveBy: delta

	super privateMoveBy: delta.
	worldState ifNotNil: [
		worldState viewBox ifNotNil: [
			worldState viewBox: self bounds
		].
	].! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'jcg 7/1/2001 23:30'!
bringWindowsFullOnscreen
	"Make ever SystemWindow on the desktop be totally on-screen, whenever possible."
	
	(SystemWindow windowsIn: self satisfying: [:w | true]) do:
		[:aWindow | 
			aWindow right: (aWindow right min: self right).
			aWindow bottom: (aWindow bottom min: self bottom).
			aWindow left: (aWindow left max: self left).
			aWindow top: (aWindow top max: self top)]! !


!GeeBookPageMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:31'!
fullDrawOn: aCanvas

	aCanvas 
		!
translateTo: self topLeft + aCanvas origin - geeMailRectangle origin 
		clippingTo: (self bounds translateBy: aCanvas origin) 
		during: [ :c |
			geeMail disablePageBreaksWhile: [geeMail fullDrawOn: c].
		].
! !


!PianoRollNoteMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:35'!
fullBounds

	selected
		ifTrue: [^ self bounds expandBy: 1]
		ifFalse: [^ self bounds]! !

!PianoRollNoteMorph methodsFor: 'selecting' stamp: 'jcg 12/31/2001 15:43'!
selectNotes: evt

	| lastMorph oldEnd saveOwner |
	saveOwner _ owner.
	(owner autoScrollForX: evt cursorPoint x) ifTrue:
		["If scroll talkes place I will be deleted and my x-pos will become invalid."
		owner _ saveOwner.
		self privateBounds: (self bounds withLeft: (owner xForTime: self noteInScore time))].
	oldEnd _ owner selection last.
	(owner notesInRect: (evt cursorPoint x @ owner top corner: owner bottomRight))
		do: [:m | m trackIndex = trackIndex ifTrue: [m deselect]].
	self select.  lastMorph _ self.
	(owner notesInRect:!
 (self left @ owner top corner: evt cursorPoint x @ owner bottom))
		do: [:m | m trackIndex = trackIndex ifTrue: [m select.  lastMorph _ m]].
	owner selection: (Array with: trackIndex with: indexInTrack with: lastMorph indexInTrack).
	lastMorph indexInTrack ~= oldEnd ifTrue:
		["Play last note as selection grows or shrinks"
		owner ifNotNil: [lastMorph playSound]]
! !


!PianoRollScoreMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:22'!
fullBounds
	"Overridden to clip submorph hit detection to my bounds."

	fullBounds ifNil: [fullBounds _ self bounds].
	^ fullBounds
! !

!PianoRollScoreMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:22'!
layoutChanged
	"Override this to avoid propagating 'layoutChanged' when just adding/removing note objects."

	fullBounds = self bounds ifTrue: [^ self].
	super layoutChanged.
! !

!PianoRollScoreMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:22'!
midiKeyForY: y

	^ lowestNote - ((y - (self bottom - borderWidth - 4)) // 3)
! !!


!PianoRollScoreMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:22'!
timeForX: aNumber

	^ ((aNumber - self left - borderWidth) asFloat / timeScale + leftEdgeTime) asInteger! !

!PianoRollScoreMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:22'!
xForTime: aNumber

	^ ((aNumber - leftEdgeTime) asFloat * timeScale) asInteger + self left + borderWidth
! !

!PianoRollScoreMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:22'!
yForMidiKey: midiKey

	^ (self bottom - borderWidth - 4) - (3 * (midiKey - lowestNote))
! !


!PinMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:40'!
updateImage
	"pinForm was made for right side.  Rotate/flip for other sides"

	self left < owner left ifTrue:  "left side"
		[^ self image: (pinForm flipBy: #horizontal centerAt: 0 at 0)].
	self bottom > owner bottom ifTrue:  "bottom"
		[^ self image: ((pinForm rotateBy: #left centerAt: 0 at 0)
								flipBy: #vertical centerAt: 0 at 0)].
	self right > owner right ifTrue:  "right side"
		[^ self im!
age: pinForm].
	self top < owner top ifTrue:  "top"
		[^ self image: (pinForm rotateBy: #left centerAt: 0 at 0)].
self halt: 'uncaught pin geometry case'! !

!PinMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:40'!
wiringEndPoint
	| side |
	side _ owner bounds sideNearestTo: self center.
	side = #left ifTrue: [^ self position + (0 at 4)].
	side = #bottom ifTrue: [^ self position + (4 at 7)].
	side = #right ifTrue: [^ self position + (7 at 4)].
	side = #top ifTrue: [^ self position + (4 at 0)]! !


!PolygonMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:26'!
containsPoint: aPoint
	(super containsPoint: aPoint) ifFalse: [^ false].

	closed & color isTransparent not ifTrue:
		[^ (self filledForm pixelValueAt: aPoint - self topLeft + 1) > 0].

	self lineSegmentsDo:
		[:p1 :p2 |
		(aPoint onLineFrom: p1 to: p2 within: (3 max: borderWidth+1//2) asFloat)
				ifTrue: [^ true]].

	self arrowForms do:
		[:f | (f pixelValueAt: aPoint - f offset) > 0 ifTrue: [^ true]].

	^ false! !

!Polygon!
Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:26'!
extent: newExtent 
	"Not really advisable, but we can preserve most of the geometry if we don't
	shrink things too small."
	| safeExtent center |
	center _ self referencePosition.
	safeExtent _ newExtent max: 20 at 20.
	self setVertices: (vertices collect:
		[:p | p - center * (safeExtent asFloatPoint / (self extent max: 1 at 1)) + center])! !

!PolygonMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:26'!
flipHAroundX: centerX
	"Flip me horizontally around the center.  If centerX is nil, compute my center of gravity."

	| cent |
	cent _ centerX 
		ifNil: [self center x
			"cent _ 0.
			vertices do: [:each | cent _ cent + each x].
			cent asFloat / vertices size"]		"average is the center"
		ifNotNil: [centerX].
	self setVertices: (vertices collect: [:vv |
			(vv x - cent) * -1 + cent @ vv y]) reversed.! !

!PolygonMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:26'!
flipVAroundY: centerY
	"Flip me vertically around !
the center.  If centerY is nil, compute my center of gravity."

	| cent |
	cent _ centerY 
		ifNil: [self center y
			"cent _ 0.
			vertices do: [:each | cent _ cent + each y].
			cent asFloat / vertices size"]		"average is the center"
		ifNotNil: [centerY].
	self setVertices: (vertices collect: [:vv |
			vv x @ ((vv y - cent) * -1 + cent)]) reversed.! !

!PolygonMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:26'!
drawOnFormCanvas: aCanvas 
	"Display the receiver, a spline curve, approximated by straight line segments."

	| |
	vertices size < 1 ifTrue: [self error: 'a polygon must have at least one point'].
	closed & color isTransparent not
		ifTrue: [aCanvas stencil: self filledForm at: self topLeft - 1 color: color].
	(borderColor isColor and: [borderColor isTranslucentColor])
		ifTrue: [aCanvas stencil: self borderForm at: self topLeft
						color: borderColor]
		ifFalse: [self drawBorderOn: aCanvas].
	self arrowForms do:
		[:f | aCanvas stencil: f at: f offset
			co!
lor: (borderColor isColor ifTrue: [borderColor] ifFalse: [color])]! !

!PolygonMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:26'!
borderForm
	"A form must be created for drawing the border whenever the borderColor is translucent."

	| borderCanvas |
	borderForm ifNotNil: [^ borderForm].
	borderCanvas _ (Display defaultCanvasClass extent: self extent depth: 1)
		shadowColor: Color black.
	borderCanvas translateBy: self topLeft negated
		during:[:tempCanvas| self drawBorderOn: tempCanvas].
	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! !

!PolygonMorph methodsFor: 'private' stamp: 'jcg 12/31/2001 15:44'!
computeBounds
	| oldBounds delta excludeHandles |
	vertices ifNil: [^ self].

	self changed.
	oldBounds _ self bounds.
	self releaseCachedState.
	self privateBounds: (self curveBounds).
	se!
lf arrowForms do:
		[:f | self privateBounds: (self bounds merge: (f offset extent: f extent))].
	handles ifNotNil: [self updateHandles].

	"since we are directly updating bounds, see if any ordinary submorphs exist and move them accordingly"
	(oldBounds notNil and: [(delta _ self position - oldBounds origin) ~= (0 at 0)]) ifTrue: [
		excludeHandles _ IdentitySet new.
		handles ifNotNil: [excludeHandles addAll: handles].
		self submorphsDo: [ :each |
			(excludeHandles includes: each) ifFalse: [
				each position: each position + delta
			].
		].
	].
	self layoutChanged.
	self changed.
! !

!PolygonMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:26'!
filledForm
	"Note: The filled form is actually 2 pixels bigger than bounds, and the point corresponding to this morphs' position is at 1 at 1 in the form.  This is due to the details of the fillig routines, at least one of which requires an extra 1-pixel margin around the outside.  Computation of the filled form is done only on de!
mand."
	| bb origin |
	closed ifFalse: [^ filledForm _ nil].
	filledForm ifNotNil: [^ filledForm].
	filledForm _ Form extent: self extent+2.

	"Draw the border..."
	bb _ (BitBlt current toForm: filledForm) sourceForm: nil; fillColor: Color black;
			combinationRule: Form over; width: 1; height: 1.
	origin _ self topLeft asIntegerPoint-1.
	self lineSegmentsDo: [:p1 :p2 | bb drawFrom: p1 asIntegerPoint-origin
										to: p2 asIntegerPoint-origin].

	"Fill it in..."
	filledForm convexShapeFill: Color black.

	(borderColor isColor and: [borderColor isTranslucentColor]) ifTrue:
		["If border is stored as a form, then erase any overlap now."
		filledForm copy: self borderForm boundingBox from: self borderForm
			to: 1 at 1 rule: Form erase].

	^ filledForm! !


!BlobMorph methodsFor: 'stepping' stamp: 'jcg 7/1/2001 23:27'!
adjustColors
	"Bob Arning <arning at charm.net>"
	"Color mixing - Sean McGrath <sean at email.ces.ucsf.edu>"
	| nearbyColors center r degrees |
	center _ self center.
!
	nearbyColors _ vertices collect:
		[:each |
		degrees _ (each - center) degrees.
		r _ (each - center) r.
		Display colorAt: (Point r: r + 6 degrees: degrees) + center].
		self color: ((self color alphaMixed: 0.95 with: (Color
			r: (nearbyColors collect: [:each | each red]) average
			g: (nearbyColors collect: [:each | each green]) average
			b: (nearbyColors collect: [:each | each blue]) average))
				alpha: self color alpha).
        sneaky ifFalse: [self color: color negated]! !


!PoohTestMorph methodsFor: 'event handling' stamp: 'jcg 7/1/2001 23:31'!
mouseMove: evt
	(lastPoint notNil and:[(lastPoint dist: evt position) < 5])  ifTrue:[^self].
	lastPoint _ evt position.
	points ifNil:[points _ WriteStream on: (Array new: 100)].
	points nextPut: (evt position - self position).
	self changed.! !

!PoohTestMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:31'!
drawOn: aCanvas
	| ptList last |
	super drawOn: aCanvas.
	aCanvas translateBy: self topLeft clippingTo: self inn!
erBounds during:[:cc|
		points ifNotNil:[
			points class == Array 
				ifTrue:[ptList _ points]
				ifFalse:[ptList _ points contents].
			last _ ptList last.
				ptList do:[:next|
					cc line: last to: next width: 5 color: (Color gray: 0.9).
					last _ next]].
		self drawSubdivisionTrianglesOn: cc.
		self drawSubdivisionEdgesOn: cc.
		self drawSubdivisionSpineOn: cc.
	].
	time ifNotNil:[
		aCanvas text: time printString,' msecs' bounds: self innerBounds font: nil color: Color black.
	].! !


!ProjectViewMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:44'!
fullDrawPostscriptOn: aCanvas

	| f |
	"handle the fact that we have the squished text within"

	f _ self imageForm.
	f offset: 0 at 0.
	aCanvas paintImage: f at: self topLeft.
! !

!ProjectViewMorph methodsFor: 'events' stamp: 'jcg 7/1/2001 22:44'!
extent: aPoint
	"Set my image form to the given extent."

	| newExtent scaleP scale |

	((self extent = aPoint) and: [image depth = Display depth]) ifFalse: [
		lastProject!
Thumbnail ifNil: [ lastProjectThumbnail _ image ].
		scaleP _ aPoint / lastProjectThumbnail extent.
		scale _ scaleP "scaleP x asFloat max: scaleP y asFloat".
		newExtent _ (lastProjectThumbnail extent * scale) rounded.
		self image: (Form extent: newExtent depth: Display depth).
		self updateImageFrom: lastProjectThumbnail.
	].
	self updateNamePosition.! !


!RulerMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:18'!
drawOn: aCanvas

	| s |
	super drawOn: aCanvas.
	s _ self width printString, 'x', self height printString.
	aCanvas text: s bounds: (self bounds insetBy: borderWidth + 5) font: nil color: Color red.
! !


!ScreeningMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:11'!
layoutChanged

	screenForm _ nil.
	submorphs size >= 2
		ifTrue: [self disableDragNDrop]
		ifFalse: [self enableDragNDrop].
	submorphs size = 2 ifTrue: [
		self privateBounds: 
			((self sourceMorph bounds merge: self screenMorph bounds) expandBy: 4)].
	^ super layoutChanged! !
!


!ScriptEditorMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:23'!
addNewRow

	| row |
	row _ AlignmentMorph newRow
		vResizing: #spaceFill;
		layoutInset: 0;
		borderWidth: 0;
		extent: (self width)@(TileMorph defaultH);
		color: Color transparent.
	self addMorphBack: row.
	^ row
! !

!ScriptEditorMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:23'!
insertTileRow: tileList after: index
	"Return a row to be used to insert an entire row of tiles."

	| row |
	row _ AlignmentMorph newRow
		vResizing: #spaceFill;
		layoutInset: 0;
		extent: (self width)@(TileMorph defaultH);
		color: Color transparent.
	row addAllMorphs: tileList.
	self privateAddMorph: row atIndex: index + 1.
! !


!ScrollPane methodsFor: 'geometry' stamp: 'jcg 12/31/2001 15:48'!
leftoverScrollRange
	"Return the entire scrolling range minus the currently viewed area."
	scroller submorphBounds ifNil: [^ 0].
	^ (self totalScrollRange - self height roundTo: self scrollDeltaHeight) max: 0
! !

!ScrollPane !
methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:06'!
resizeScrollBar
	| w topLeft |
	w _ self scrollbarWidth.
	topLeft _ scrollBarOnLeft
		ifTrue: [retractableScrollBar ifTrue: [self topLeft - (w-borderWidth at 0)]
									ifFalse: [self topLeft + (borderWidth-1 at 0)]]
		ifFalse: [retractableScrollBar ifTrue: [self topRight - (borderWidth at 0)]
									ifFalse: [self topRight - (w+borderWidth-1 at 0)]].
	scrollBar bounds: (topLeft extent: w @ self height)! !


!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'jcg 12/31/2001 16:00'!
extraScrollRange

	^ self height
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:08'!
scrollSelectionIntoView: event alignTop: alignTop inTextMorph: tm
	"Scroll my text into view if necessary and return true, else return false"

	| selRects delta selRect rectToTest transform cpHere |

	selRects _ tm paragraph selectionRects.
	selRects isEmpty ifTrue: [^ false].
	rectToTest _ selRects first merge: selRects last!
.
	transform _ scroller transformFrom: self.
	(event notNil and: [event isMouse and: [event anyButtonPressed]]) ifTrue:  "Check for autoscroll"
		[cpHere _ transform localPointToGlobal: event cursorPoint.
		cpHere y <= self top
			ifTrue: [rectToTest _ selRects first topLeft extent: 2 at 2]
			ifFalse: [cpHere y >= self bottom
					ifTrue: [rectToTest _ selRects last bottomRight extent: 2 at 2]
					ifFalse: [^ false]]].
	selRect _ transform localBoundsToGlobal: rectToTest.
	selRect height > self height
		ifTrue: [^ false].  "Would not fit, even if we tried to scroll"
	alignTop ifTrue: [
		self scrollBy: 0@(self top - selRect top).
		^ true
	].
	selRect bottom > self bottom ifTrue: [
		self scrollBy: 0@(self bottom - selRect bottom - 30).
		^ true
	].
	(delta _ selRect amountToTranslateWithin: self bounds) y ~= 0 ifTrue: [
		"Scroll end of selection into view if necessary"
		self scrollBy: 0 at delta y.
		^ true].
	^ false! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' st!
amp: 'jcg 7/1/2001 23:08'!
scrollToYAbsolute: yValue

	| transform transformedPoint |

	transform _ scroller transformFrom: self.
	transformedPoint _ transform localPointToGlobal: 0 at yValue.

	self scrollBy: 0@(self top - transformedPoint y).
! !


!PluggableListMorph methodsFor: 'selection' stamp: 'jcg 7/1/2001 23:07'!
selectionIndex: index
	"Called internally to select the index-th item."
	| theMorph range |
	(index isNil or: [index > scroller submorphs size]) ifTrue: [^ self].
	(theMorph _ index = 0 ifTrue: [nil] ifFalse: [scroller submorphs at: 
index])
		ifNotNil:
		[((theMorph top - scroller offset y) >= 0
			and: [(theMorph bottom - scroller offset y) <= self height]) 
ifFalse:
			["Scroll into view -- should be elsewhere"
			range _ self leftoverScrollRange.
			scrollBar value: (range > 0
				ifTrue: [((index-1 * theMorph height) / self leftoverScrollRange)
									truncateTo: scrollBar scrollDelta]
				ifFalse: [0]).
			scroller offset: -3 @ (range * scrollBar value!
)]].
	self selectedMorph: theMorph! !


!PluggableMultiColumnListMorph methodsFor: 'selection' stamp: 'jcg 7/1/2001 23:07'!
selectionIndex: index 
	"Called internally to select the index-th item."
	| theMorph range |
	(index isNil
			or: [index > scroller submorphs size])
		ifTrue: [^ self].
	(theMorph _ index = 0
				ifFalse: [scroller submorphs at: index])
		ifNotNil: [(theMorph top - scroller offset y >= 0
					and: [theMorph bottom - scroller offset y <= self height])
				ifFalse: ["Scroll into view -- should be elsewhere"
					range _ self leftoverScrollRange.
					scrollBar
						value: (range > 0
								ifTrue: [index - 1 * theMorph height / self leftoverScrollRange truncateTo: scrollBar scrollDelta]
								ifFalse: [0]).
					scroller offset: -3 @ (range * scrollBar value)]].
	"Save the selection index to make it easy to do the highlighting work  
	later."
	selectedIndex _ index.
	self selectedMorph: theMorph! !


!PluggableTextMorph methodsFor: 'editor access' sta!
mp: 'jcg 7/1/2001 23:06'!
scrollSelectionIntoView: event 
	"Scroll my text into view if necessary and return true, else return false"
	| selRects delta selRect rectToTest transform cpHere |
	selectionInterval _ textMorph editor selectionInterval.
	selRects _ textMorph paragraph selectionRects.
	selRects isEmpty ifTrue: [^ false].
	rectToTest _ selRects first merge: selRects last.
	transform _ scroller transformFrom: self.
	(event notNil and: [event anyButtonPressed]) ifTrue:  "Check for autoscroll"
		[cpHere _ transform localPointToGlobal: event cursorPoint.
		cpHere y <= self top
			ifTrue: [rectToTest _ selRects first topLeft extent: 2 at 2]
			ifFalse: [cpHere y >= self bottom
					ifTrue: [rectToTest _ selRects last bottomRight extent: 2 at 2]
					ifFalse: [^ false]]].
	selRect _ transform localBoundsToGlobal: rectToTest.
	selRect height > self height
		ifTrue: [^ false].  "Would not fit, even if we tried to scroll"
	(delta _ selRect amountToTranslateWithin: self bounds) y ~=!
 0 ifTrue:
		["Scroll end of selection into view if necessary"
		self scrollBy: 0 at delta y.
		^ true].
	^ false! !


!SelectionMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:27'!
selectSubmorphsOf: aMorph

	| newItems removals |
	newItems _ aMorph submorphs select:
		[:m | (self bounds containsRect: m fullBounds) 
					and: [m~~self
					and: [(m isKindOf: HaloMorph) not]]].
	otherSelection ifNil: [^ selectedItems _ newItems].

	removals _ newItems intersection: itemsAlreadySelected.
	otherSelection setSelectedItems: (itemsAlreadySelected copyWithoutAll: removals).
	selectedItems _ (newItems copyWithoutAll: removals).
! !


!SimpleButtonMorph methodsFor: 'fileIn/Out' stamp: 'jcg 7/1/2001 23:20'!
objectForDataStream: refStrm
	"I am about to be written on an object file.  If I send a message to a BookMorph, it would be bad to write that object out.  Create and write out a URLMorph instead."

	| bb thatPage um stem ind sqPg |
	(actionSelector == #goToPageMorph:fromBookmark:!
) | 
		(actionSelector == #goToPageMorph:) ifFalse: [
			^ super objectForDataStream: refStrm].	"normal case"

	target url ifNil: ["Later force target book to get a url."
		bb _ SimpleButtonMorph new.	"write out a dummy"
		bb label: self label.
		bb bounds: self bounds.
		refStrm replace: self with: bb.
		^ bb].

	(thatPage _ arguments first) url ifNil: [
			"Need to assign a url to a page that will be written later.
			It might have bookmarks too.  Don't want to recurse deeply.  
			Have that page write out a dummy morph to save its url on the server."
		stem _ target getStemUrl.	"know it has one"
		ind _ target pages identityIndexOf: thatPage.
		thatPage reserveUrl: stem,(ind printString),'.sp'].
	um _ URLMorph newForURL: thatPage url.
	sqPg _ thatPage sqkPage clone.
	sqPg contentsMorph: nil.
	um setURL: thatPage url page: sqPg.
	(SqueakPage stemUrl: target url) = (SqueakPage stemUrl: thatPage url) 
		ifTrue: [um book: true]
		ifFalse: [um book: target url].  	"remember wh!
ich book"
	um privateOwner: owner.
	um bounds: self bounds.
	um isBookmark: true; label: self label.
	um borderWidth: borderWidth; borderColor: borderColor.
	um color: color.
	refStrm replace: self with: um.
	^ um! !


!MinesTile methodsFor: 'accessing' stamp: 'jcg 12/31/2001 16:08'!
drawOn: aCanvas 
	"Draw a rectangle with a solid, inset, or raised border.
	Note: the raised border color *and* the inset border color are generated
	from the receiver's own color, instead of having the inset border color
	generated from the owner's color, as in BorderedMorph."

	| font rct |

	borderWidth = 0 ifTrue: [  "no border"
		aCanvas fillRectangle: self bounds color: color.
		^ self].

	borderColor == #raised ifTrue: [
		^ aCanvas 
			frameAndFillRectangle: self bounds
			fillColor: color
			borderWidth: borderWidth
			topLeftColor: color lighter lighter
			bottomRightColor: color darker darker darker].

	borderColor == #inset ifTrue: [
		aCanvas 
			frameAndFillRectangle: self bounds
	!
		fillColor: color
			borderWidth: 1 " borderWidth"
			topLeftColor: (color darker darker darker)
			bottomRightColor: color lighter.
		self isMine ifTrue: [  
			font  _ StrikeFont familyName: 'Atlanta' size: 22 emphasized: 1.
			rct _ self bounds insetBy: ((self width) - (font widthOfString: '*'))/2 at 0.
			rct _ rct top: rct top + 1.
			aCanvas text: '*' bounds: (rct translateBy: 1 at 1) font: font color: Color black.
			^ aCanvas text: '*' bounds: rct font: font color: Color red .].
		self nearMines > 0 ifTrue: [ 
			font _ StrikeFont familyName: 'ComicBold' size: 22 emphasized: 1.
			rct _ self bounds insetBy: 
					((self width) - (font widthOfString: nearMines asString))/2 at 0.
			rct _ rct top: rct top + 1.
			aCanvas text: nearMines asString bounds: (rct translateBy: 1 at 1) font: font color: Color black.
			^ aCanvas text: nearMines asString bounds: rct font: font color: ((palette at: nearMines) ) .].
		^self. ].

	"solid color border"
	aCanvas 
		frameAndFillRectangle: self!
 bounds
		fillColor: color
		borderWidth: borderWidth
		borderColor: borderColor.! !


!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'jcg 7/1/2001 23:07'!
selectionIndex: index
	"Called internally to select the index-th item."
	| theMorph range |
	index ifNil: [^ self].
	(theMorph _ index = 0 ifTrue: [nil] ifFalse: [scroller submorphs at: index])
		ifNotNil:
		[((theMorph top - scroller offset y) >= 0
			and: [(theMorph bottom - scroller offset y) <= self height]) ifFalse:
			["Scroll into view -- should be elsewhere"
			range _ self totalScrollRange.
			scrollBar value: (range > 0
				ifTrue: [((index-1 * theMorph height) / self totalScrollRange)
									truncateTo: scrollBar scrollDelta]
				ifFalse: [0]).
			scroller offset: -3 @ (range * scrollBar value)]].
	self selectedMorph: theMorph! !


!SketchEditorMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 23:34'!
initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosi!
tion: aPosition
	"NB: if aPosition is nil, then it's assumed that the paintbox is obtained from a flap or some such, so do nothing special regarding a palette in this case.  The palette needs already to be in the world for this to work."
	| w  |
	(w _ aPasteUpMorph world) addMorphFront: self.
	enclosingPasteUpMorph _ aPasteUpMorph.
	hostView _ aSketchMorph.  "may be ownerless"
	self bounds: boundsToUse.
	palette _ w paintBox focusMorph: self.
	palette beStatic.		"give Nebraska whatever help we can"
	palette fixupButtons.
	palette addWeakDependent: self.
	aPosition ifNotNil:
		[w addMorphFront: palette.  "bring to front"
		palette position: aPosition].
	paintingForm _ Form extent: self extent depth: w assuredCanvas depth.
	self dimTheWindow.
	self addRotationScaleHandles.
	aSketchMorph ifNotNil:
		[
		aSketchMorph form
			displayOn: paintingForm
			at: (hostView boundsInWorld origin - self position - hostView form offset)
			clippingBox: (0 at 0 extent: paintingForm extent)
			r!
ule: Form over
			fillColor: nil.  "assume they are the same depth"
		rotationCenter _ aSketchMorph rotationCenter]! !

!SketchEditorMorph methodsFor: 'morphic' stamp: 'jcg 7/1/2001 23:33'!
drawOn: aCanvas
	"Put the painting on the display"

	color isTransparent ifFalse: [
		aCanvas fillRectangle: self bounds color: color
	].
	paintingForm ifNotNil: [
		aCanvas paintImage: paintingForm at: self position].

 ! !

!SketchEditorMorph methodsFor: 'morphic' stamp: 'jcg 7/1/2001 23:35'!
mouseDown: evt
	"Start a new stroke.  Check if any palette setting have changed.  6/11/97 20:30 tk"
	| cur pfPen myAction |
	"verify that we are in a good state"
	self verifyState: evt.		"includes prepareToPaint and #scalingOrRotate"
	pfPen _ self get: #paintingFormPen for: evt.
	undoBuffer _ paintingForm deepCopy.	"know we will draw something"
	pfPen place: (evt cursorPoint - self position).
	myAction _ self getActionFor: evt.
	myAction == #paint: ifTrue:[
		palette recentColor: (self getColorFor:!
 evt)].
	self set: #strokeOrigin for: evt to: evt cursorPoint.
		"origin point for pickup: rect: ellispe: polygon: line: star:.  Always take it."
	myAction == #pickup: ifTrue: [
		cur _ Cursor corner clone.
		cur offset: 0 at 0  "cur offset abs".
		evt hand showTemporaryCursor: cur].
	myAction == #polygon: ifTrue: [self polyNew: evt].	"a mode lets you drag vertices"
	self mouseMove: evt.! !

!SketchEditorMorph methodsFor: 'start & finish' stamp: 'jcg 7/1/2001 23:34'!
addRotationScaleHandles

	"Rotation and scaling handles"

	rotationButton _ SketchMorph withForm: (palette rotationTabForm).
	rotationButton position: self bounds topCenter - (6 at 0).
	rotationButton on: #mouseDown send: #rotateScalePrep: to: self.
	rotationButton on: #mouseMove send: #rotateBy: to: self.
	rotationButton on: #mouseUp send: #rotateDone: to: self.
	rotationButton on: #mouseEnter send: #mouseLeave: to: self.
	"Put cursor back"
	rotationButton on: #mouseLeave send: #mouseEnter: to: self.
	self addMorph: !
rotationButton.
	rotationButton setBalloonText: 'Drag me sideways to\rotate your
picture.' withCRs.

	scaleButton _ SketchMorph withForm: (palette scaleTabForm).
	scaleButton position: self bounds rightCenter - ((scaleButton width)@6).
	scaleButton on: #mouseDown send: #rotateScalePrep: to: self.
	scaleButton on: #mouseMove send: #scaleBy: to: self.
	scaleButton on: #mouseEnter send: #mouseLeave: to: self.
	"Put cursor back"
	scaleButton on: #mouseLeave send: #mouseEnter: to: self.
	self addMorph: scaleButton.
	scaleButton setBalloonText: 'Drag me up and down to change\the size
of your picture.' withCRs.

"REMOVED:
	fwdButton _ PolygonMorph new.
	pt _ self bounds topCenter.
	fwdButton borderWidth: 2; makeOpen; makeBackArrow; borderColor:
(Color r: 0 g: 0.8 b: 0).
	fwdButton removeHandles; setVertices: (Array with: pt+(0 at 7) with:
pt+(0 at 22)).
	fwdButton on: #mouseMove send: #forward:direction: to: self.
	fwdButton on: #mouseEnter send: #mouseLeave: to: self.	
	fwdButton on: #m!
ouseLeave send: #mouseEnter: to: self.
	self setProperty: #fwdButton toValue: fwdButton.
	self addMorph: fwdButton.
	fwdButton setBalloonText: 'Drag me around to point\in the direction
I go forward.' withCRs.

	toggle _ EllipseMorph
		newBounds: (Rectangle center: fwdButton vertices last +
(-4 at 4) extent: 8 at 8)
		color: Color gray.
	toggle on: #mouseUp send: #toggleDirType:in: to: self.
	toggle on: #mouseEnter send: #mouseLeave: to: self.
	toggle on: #mouseLeave send: #mouseEnter: to: self.
	self setProperty: #fwdToggle toValue: toggle.
	fwdButton addMorph: toggle.
	toggle setBalloonText: 'When your object turns,\how should its
picture change?\It can rotate, face left or right,\face up or down, or not
change.' withCRs.
	"
	self setProperty: #rotationStyle toValue: hostView rotationStyle.
"	self forward: hostView setupAngle direction: fwdButton.	"
	"Set to its current value"

! !

!SketchEditorMorph methodsFor: 'start & finish' stamp: 'jcg 7/1/2001 23:35'!
deliverPainting: resu!
lt evt: evt
	"Done painting.  May come from resume, or from original call.  Execute user's post painting instructions in the block.  Always use this standard one.  4/21/97 tk"

	| newBox newForm ans |
	palette ifNotNil: "nil happens" [palette setAction: #paint: evt: evt].	"Get out of odd modes"
	"rot _ palette getRotations."	"rotate with heading, or turn to and fro"
	"palette setRotation: #normal."
	result == #cancel ifTrue: [
		ans _ PopUpMenu withCaption: 'Do you really want to throw away 
what you just painted?' 
				chooseFrom: 'throw it away\keep painting it'.
		^ ans = 1 ifTrue: [self cancelOutOfPainting]
				ifFalse: [nil]].	"for Morphic"

	"hostView rotationStyle: rot."		"rotate with heading, or turn to and fro"
	newBox _ paintingForm rectangleEnclosingPixelsNotOfColor: Color transparent.
	registrationPoint ifNotNil:
		[registrationPoint _ registrationPoint - newBox origin]. "relative to newForm origin"
	newForm _ 	Form extent: newBox extent depth: paintingForm depth!
.
	newForm copyBits: newBox from: paintingForm at: 0 at 0 
		clippingBox: newForm boundingBox rule: Form over fillColor: nil.
	newForm isAllWhite ifTrue: [
		(self valueOfProperty: #background) == true 
			ifFalse: [^ self cancelOutOfPainting]].

	self delete.	"so won't find me again"
	dimForm ifNotNil: [dimForm delete].
	newPicBlock value: newForm value: (newBox copy translateBy: self position).
! !

!SketchEditorMorph methodsFor: 'start & finish' stamp: 'jcg 7/1/2001 23:34'!
prepareToPaint: evt
	"Figure out what the current brush, fill, etc is.  Return an action to take every mouseMove.  Set up instance variable and pens.  Prep for normal painting is inlined here.  tk 6/14/97 21:11"

	| specialMode pfPen cColor cNib myBrush |
	"Install the brush, color, (replace mode), and cursor."
	specialMode _ self getActionFor: evt.
 	cColor  _ self getColorFor: evt.
	cNib _ self getNibFor: evt.
	self set: #brush for: evt to: (myBrush _ cNib).
	self set: #paintingFormPen for: evt to: (pf!
Pen _ Pen newOnForm: paintingForm).
	self set: #stampForm for: evt to: nil.	"let go of stamp"
	formCanvas _ paintingForm getCanvas.	"remember to change when undo"
	formCanvas _ formCanvas
		copyOrigin: self topLeft negated
		clipRect: (0 at 0 extent: self extent).

	specialMode == #paint: ifTrue: [
		"get it to one bit depth.  For speed, instead of going through a colorMap every time ."
		self set: #brush for: evt to: (myBrush _ Form extent: myBrush extent depth: 1).
		myBrush offset: (0 at 0) - (myBrush extent // 2).
		cNib displayOn: myBrush at: (0 at 0 - cNib offset).

		pfPen sourceForm: myBrush.
		pfPen combinationRule: Form paint.
		pfPen color: cColor.
		cColor isTransparent ifTrue: [
			pfPen combinationRule: Form erase1bitShape.
			pfPen color: Color black].
		^ #paint:].

	specialMode == #erase: ifTrue: [
		self erasePrep: evt.
		^ #erase:].
	specialMode == #stamp: ifTrue: [
		self set: #stampForm for: evt to: palette stampForm.	"keep it"
		^ #stamp:].

	(self respondsTo: s!
pecialMode) 
		ifTrue: [^ specialMode]	"fill: areaFill: pickup: (in mouseUp:) 
				rect: ellipse: line: polygon: star:"
		ifFalse: ["Don't recognise the command"
			palette setAction: #paint: evt: evt.	"set it to Paint"
			^ self prepareToPaint: evt].! !

!SketchEditorMorph methodsFor: 'start & finish' stamp: 'jcg 7/1/2001 23:35'!
undo: evt
	"revert to a previous state.  "

	| temp poly |

	self flag: #bob.		"what is undo in multihand environment?"
	undoBuffer ifNil: [^ self beep].	"nothing to go back to"
	(poly _ self valueOfProperty: #polygon) ifNotNil:
		[poly delete.
		self setProperty: #polygon toValue: nil.
		^ self].
	temp _ paintingForm.
	paintingForm _ undoBuffer.
	undoBuffer _ temp.		"can get back to what you had by undoing again"
	(self get: #paintingFormPen for: evt) setDestForm: paintingForm.
	formCanvas _ paintingForm getCanvas.	"used for lines, ovals, etc."
	formCanvas _ formCanvas
		copyOrigin: self topLeft negated
		clipRect: (0 at 0 extent: self extent).
	self!
 render: self bounds.! !

!SketchEditorMorph methodsFor: 'start & finish' stamp: 'jcg 7/1/2001 23:36'!
verifyState: evt
	| myAction |
	"We are sure we will make a mark now.  Make sure the palette has not changed state while we were away.  If so, end this action and start another one.  6/11/97 19:52 tk  action, currentColor, brush"

	"Install the brush, color, (replace mode), and cursor."
	palette isInWorld ifFalse:
		[self world addMorphFront: palette].  "It happens.  might want to position it also"
	myAction _ self getActionFor: evt.
	(self get: #changed for: evt) == false ifFalse: [
		self set: #changed for: evt to: false.
		self invalidRect: rotationButton bounds.	"snap these back"
		rotationButton position: self bounds topCenter - (6 at 0).		"later adjust by button width?"
		self invalidRect: rotationButton bounds.
		self invalidRect: scaleButton bounds.
		scaleButton position: self bounds rightCenter - ((scaleButton width)@6).
		self invalidRect: scaleButton bounds.
		myAc!
tion == #polygon: ifFalse: [self polyFreeze].		"end polygon mode"
		^ self set: #action for: evt to: (self prepareToPaint: evt)].

! !

!SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:33'!
clear
	"wipe out all the paint"

	self polyFreeze.		"end polygon mode"
	paintingForm fillWithColor: Color transparent.
	self invalidRect: self bounds.! !

!SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:36'!
fill: evt 
	"Find the area that is the same color as where you clicked. Fill it with 
	the current paint color."
	| box |
	evt isMouseUp
		ifFalse: [^ self].
	"Only fill upon mouseUp"
	"would like to only invalidate the area changed, but can't find out what it is."
	Cursor execute
		showWhile: [
			box _ paintingForm
				floodFill: (self getColorFor: evt)
				at: evt cursorPoint - self position.
			self render: (box translateBy: self position)]! !

!SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:34'!
flipHoriz: !
evt 
	"Flip the image"
	| temp myBuff |

	myBuff _ self get: #buff for: evt.
	temp _ myBuff deepCopy flipBy: #horizontal centerAt: myBuff center.
	temp offset: 0 @ 0.
	paintingForm fillWithColor: Color transparent.
	temp displayOn: paintingForm at: paintingForm center - myBuff center + myBuff offset.
	rotationButton position: evt cursorPoint x - 6 @ rotationButton position y.
	self render: self bounds! !

!SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:36'!
flipVert: evt 
	"Flip the image"
	| temp myBuff |

	myBuff _ self get: #buff for: evt.
	temp _ myBuff deepCopy flipBy: #vertical centerAt: myBuff center.
	temp offset: 0 @ 0.
	paintingForm fillWithColor: Color transparent.
	temp displayOn: paintingForm at: paintingForm center - myBuff center + myBuff offset.
	rotationButton position: evt cursorPoint x - 6 @ rotationButton position y.
	self render: self bounds! !

!SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:34'!
forward!
: evt direction: button
	"Move the forward direction arrow of this painting.  When the user
says forward:, the object moves in the direction of the arrow.  evt may be
an Event (from the user moving the arrow), or an initial number ofdegrees."

	| center dir ww ff |
	center _ self center "+ (rotationButton width - 6 @ 0)".
	evt isNumber ifTrue: [dir _ Point r: 100 degrees: evt - 90.0
"convert to 0 on X axis"]
		ifFalse: [dir _ evt cursorPoint - center].
	ww _ (self height min: self width)//2 - 7.
	button setVertices: (Array
		with: (center + (Point r: ww degrees: dir degrees))
		with: (center + (Point r: ww-15 degrees: dir degrees))).
	(ff _ self valueOfProperty: #fwdToggle) position:
		(center + (Point r: ww-7 degrees: dir degrees + 6.5)) - (ff
extent // 2).
	self showDirType.
! !

!SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:36'!
paint: evt
	"While the mouse is down, lay down paint, but only within window bounds.
	 11/28/96 sw: no longer stop pai!
nting when pen strays out of window; once it comes back in, resume painting rather than waiting for a mouse up"

	|  mousePoint startRect endRect startToEnd pfPen myBrush |

	pfPen _ self get: #paintingFormPen for: evt.
	myBrush _ self getBrushFor: evt.
	mousePoint _ evt cursorPoint.
	startRect _ pfPen location + myBrush offset extent: myBrush extent.
	pfPen goto: mousePoint - self position.
	endRect _ pfPen location + myBrush offset extent: myBrush extent.
	"self render: (startRect merge: endRect).	Show the user what happened"
	startToEnd _ startRect merge: endRect.
	self invalidRect: (startToEnd translateBy: self position).
! !

!SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:33'!
pickupMouseUp: evt
	"Grab a part of the picture (or screen) and store it in a known place. Like Copy on the Mac menu. Then switch to the stamp tool."

	| rr pForm ii oldRect sOrigin priorEvt |

	sOrigin _ self get: #strokeOrigin for: evt.
	(priorEvt _ self get: #lastEvent!
 for: evt) == nil ifFalse: [
			"Last draw will stick out, must erase the area"
			oldRect _ sOrigin rect: priorEvt cursorPoint + (14 at 14).
			self restoreRect: (oldRect insetBy: -2)].
	self primaryHand showTemporaryCursor: nil.	"later get rid of this"	
	rr _ sOrigin rect: evt cursorPoint + (14 at 14).
	ii _ rr translateBy: self position negated.
	(rr intersects: self bounds) ifTrue: [
		pForm _ paintingForm copy: ii.
		pForm isAllWhite "means transparent" 
			ifFalse: []	"normal case.  Can be transparent in parts"
			ifTrue: [pForm _ nil.
			"Get an un-dimmed picture of other objects on the playfield"
			"don't know how yet"]].
	pForm ifNil: [pForm _ Form fromDisplay: rr].		"Anywhere on the screen"
	palette pickupForm: pForm evt: evt.
	evt hand showTemporaryCursor: (self getCursorFor: evt).
! !

!SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:35'!
rotateBy: evt 
	"Left-right is rotation. 3/26/97 tk Slider at top of window. 4/3/97 tk"
	| pt temp amt smoo!
th myBuff |

	myBuff _ self get: #buff for: evt.
	evt cursorPoint x - self left < 20
		ifTrue: [^ self flipHoriz: evt].
	"at left end flip horizontal"
	evt cursorPoint x - self right > -20
		ifTrue: [^ self flipVert: evt].
	"at right end flip vertical"
	pt _ evt cursorPoint - self center.
	smooth _ 2.
	"paintingForm depth > 8 ifTrue: [2] ifFalse: [1]."
	"Could go back to 1 for speed"
	amt _ pt x abs < 12
				ifTrue: ["detent"
					0]
				ifFalse: [pt x - (12 * pt x abs // pt x)].
	amt _ amt * 1.8.
	temp _ myBuff
				rotateBy: amt
				magnify: cumMag
				smoothing: smooth.
	temp displayOn: paintingForm at: paintingForm center - temp center + myBuff offset.
	rotationButton position: evt cursorPoint x - 6 @ rotationButton position y.
	self render: self bounds.
	cumRot _ amt! !

!SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:33'!
scaleBy: evt 
	"up-down is scale. 3/26/97 tk Now a slider on the right."
	| pt temp cy oldRect amt myBuff |

	myBuff _ self g!
et: #buff for: evt.
	pt _ evt cursorPoint - self center.
	cy _ self height * 0.5.
	oldRect _ myBuff boundingBox expandBy: myBuff extent * cumMag / 2.
	amt _ pt y abs < 12
				ifTrue: ["detent"
					1.0]
				ifFalse: [pt y - (12 * pt y abs // pt x)].
	amt _ amt asFloat / cy + 1.0.
	temp _ myBuff
				rotateBy: cumRot
				magnify: amt
				smoothing: 2.
	cumMag > amt
		ifTrue: ["shrinking"
			oldRect _ oldRect translateBy: paintingForm center - oldRect center + myBuff offset.
			paintingForm
				fill: (oldRect expandBy: 1 @ 1)
				rule: Form over
				fillColor: Color transparent].
	temp displayOn: paintingForm at: paintingForm center - temp center + myBuff offset.
	scaleButton position: scaleButton position x @ (evt cursorPoint y - 6).
	self render: self bounds.
	cumMag _ amt! !

!SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:35'!
stamp: evt
	"plop one copy of the user's chosen Form down."

	"Check depths"
	| pt sForm |

	sForm _ self get: #stampForm fo!
r: evt.
	pt _ evt cursorPoint - (sForm extent // 2).
	sForm displayOn: paintingForm 
		at: pt - self position
		clippingBox: paintingForm boundingBox
		rule: Form paint
		fillColor: nil.
	self render: (pt extent: sForm extent).
! !


!SketchMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:36'!
drawOn: aCanvas
	aCanvas paintImage: self rotatedForm at: self position
! !

!SketchMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:37'!
drawPostscriptOn: aCanvas

	| top f2 c2 tfx clrs |

	tfx _ self transformFrom: self world.
	tfx angle = 0.0 ifFalse: [^super drawPostscriptOn: aCanvas].	"can't do rotated yet"
	clrs _ self rotatedForm colorsUsed.
	(clrs includes: Color transparent) 
		ifFalse: [^super drawPostscriptOn: aCanvas].		"no need for this, then"

"Smalltalk at: #Q put: OrderedCollection new"
"Q add: {self. tfx. clrs}."
"(self hasProperty: #BOB) ifTrue: [self halt]."

	top _ aCanvas topLevelMorph.
	f2 _ Form extent: self extent depth: self rotatedForm depth.
	c2 _ f2 ge!
tCanvas.
	c2 fillColor: Color white.
	c2 translateBy: self position negated clippingTo: f2 boundingBox during: [ :c |
		top fullDrawOn: c
	].
	aCanvas paintImage: f2 at: self position

! !

!SketchMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:36'!
containsPoint: aPoint

	^ (self bounds containsPoint: aPoint) and:
	  [(self rotatedForm isTransparentAt: aPoint - self position) not]
! !

!SketchMorph methodsFor: 'change reporting' stamp: 'jcg 7/1/2001 22:22'!
layoutChanged
	"Update rotatedForm and compute new bounds."
	self changed.
	self generateRotatedForm.
	self privateBounds: (self bounds origin extent: rotatedForm extent).
	super layoutChanged.
	self changed.
! !


!BookPageThumbnailMorph methodsFor: 'fileIn/Out' stamp: 'jcg 7/1/2001 23:38'!
objectForDataStream: refStrm
	"I am about to be written on an object file.  It would be bad to write a whole BookMorph out.  Store a string that is the url of the book or page in my inst var."

	| clone bookUrl bb stem ind |
	(b!
ookMorph class == String) & (page class == String) ifTrue: [
		^ super objectForDataStream: refStrm].
	(bookMorph == nil) & (page class == String) ifTrue: [
		^ super objectForDataStream: refStrm].
	(bookMorph == nil) & (page url ~~ nil) ifTrue: [
		^ super objectForDataStream: refStrm].
	(bookMorph == nil) & (page url == nil) ifTrue: [
		self error: 'page should already have a url'.
		"find page's book, and remember it"
		"bookMorph _ "].
	
	clone _ self clone.
	(bookUrl _ bookMorph url)
		ifNil: [bookUrl _ self valueOfProperty: #futureUrl].
	bookUrl 
		ifNil: [	bb _ RectangleMorph new.	"write out a dummy"
			bb bounds: self bounds.
			refStrm replace: self with: bb.
			^ bb]
		ifNotNil: [clone instVarNamed: 'bookMorph' put: bookUrl].

	page url ifNil: [
			"Need to assign a url to a page that will be written later.
			It might have bookmarks too.  Don't want to recurse deeply.  
			Have that page write out a dummy morph to save its url on the server."
		stem _ SqueakPage s!
temUrl: bookUrl.
		ind _ bookMorph pages identityIndexOf: page.
		page reserveUrl: stem,(ind printString),'.sp'].
	clone instVarNamed: 'page' put: page url.
	refStrm replace: self with: clone.
	^ clone! !


!FatBitsPaint methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:38'!
drawOn: aCanvas
	| f |
	f _ self rotatedForm.
	backgroundColor ifNotNil: [aCanvas fillRectangle: self bounds fillStyle: backgroundColor].
	aCanvas translucentImage: f at: self position.! !


!MPEGImageMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:38'!
drawOn: aCanvas
	aCanvas drawImage: self rotatedForm at: self position! !


!MultiuserTinyPaint methodsFor: 'events' stamp: 'jcg 7/1/2001 23:37'!
mouseMove: evt

	| state lastP p pen |
	state _ drawState at: evt hand ifAbsent: [^ self].
	lastP _ state at: LastMouseIndex.
	p _ evt cursorPoint.
	p = lastP ifTrue: [^ self].

	pen _ state at: PenIndex.
	pen drawFrom: lastP - self position to: p - self position.
	self invalidRect: (
		((lastP min: p) - pen sou!
rceForm extent) corner:
		((lastP max: p) + pen sourceForm extent)).
	state at: LastMouseIndex put: p.
! !


!Slider methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:08'!
computeSlider
	| r |
	r _ self roomToMove.
	self descending
		ifFalse:
			[slider position: (self bounds isWide
				ifTrue: [r topLeft + ((r width * value) asInteger @ 0)]
				ifFalse: [r topLeft + (0 @ (r height * value)  asInteger)])]
		ifTrue:
			[slider position: (self bounds isWide
				ifTrue:	[r bottomRight - ((r width * value) asInteger @ 0)]
				ifFalse:	[r bottomRight - ((0 @ (r height * value) asInteger))])].
	slider extent: self sliderExtent! !

!Slider methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:08'!
extent: newExtent
	newExtent = self extent ifTrue: [^ self].
	self bounds isWide
		ifTrue: [super extent: (newExtent x max: self sliderThickness * 2) @ newExtent y]
		ifFalse: [super extent: newExtent x @ (newExtent y max: self sliderThickness * 2)].
	self removeAllMorphs; initializeSlider! !

!Sli!
der methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:08'!
sliderExtent
	^ self bounds isWide
		ifTrue: [self sliderThickness @ self innerBounds height]
		ifFalse: [self innerBounds width @ self sliderThickness]! !

!Slider methodsFor: 'scrolling' stamp: 'jcg 7/1/2001 23:09'!
scrollAbsolute: event
	| r p |
	r _ self roomToMove.
	self bounds isWide
		ifTrue: [r width = 0 ifTrue: [^ self]]
		ifFalse: [r height = 0 ifTrue: [^ self]].
	p _ event targetPoint adhereTo: r.
	self descending
		ifFalse:
			[self setValue: (self bounds isWide 
				ifTrue: [(p x - r left) asFloat / r width]
				ifFalse: [(p y - r top) asFloat / r height])]
		ifTrue:
			[self setValue: (self bounds isWide
				ifTrue: [(r right - p x) asFloat / r width]
				ifFalse:	[(r bottom - p y) asFloat / r height])]! !


!ScrollBar methodsFor: 'initialize' stamp: 'jcg 7/1/2001 23:11'!
initializeDownButton
	downButton := RectangleMorph
		newBounds: (self innerBounds bottomRight - self buttonExtent extent: self buttonExt!
ent)
		color: Color lightGray.
	downButton on: #mouseDown send: #scrollDownInit to: self.
	downButton on: #mouseUp send: #finishedScrolling to: self.
	downButton addMorphCentered: (ImageMorph new image: 
		(self 
			cachedImageAt: (self bounds isWide ifTrue: ['right'] ifFalse: ['down']) 
			ifAbsentPut: [
				self upArrow8Bit
					rotateBy: (self bounds isWide ifTrue: [#right] ifFalse: [#pi])
					centerAt: 0 at 0
			]
		)
	).
	downButton setBorderWidth: 1 borderColor: #raised.
	self addMorph: downButton! !

!ScrollBar methodsFor: 'initialize' stamp: 'jcg 7/1/2001 23:09'!
initializeUpButton
	upButton := RectangleMorph
		newBounds: ((menuButton ifNil: [self innerBounds topLeft]
				ifNotNil: [self bounds isWide ifTrue: [menuButton topRight]
									ifFalse: [menuButton bottomLeft]])
					extent: self buttonExtent)
		color: Color lightGray.
	upButton on: #mouseDown send: #scrollUpInit to: self.
	upButton on: #mouseUp send: #finishedScrolling to: self.
	upButton addMorphCentered:!
 (ImageMorph new image:
		(self 
			cachedImageAt: (self bounds isWide ifTrue: ['left'] ifFalse: ['up'])
			ifAbsentPut: [
				self bounds isWide ifTrue: [
					self upArrow8Bit rotateBy: #left centerAt: 0 at 0
				] ifFalse: [
					self upArrow8Bit
				]
			]
		)
	).
	upButton setBorderWidth: 1 borderColor: #raised.
	self addMorph: upButton! !

!ScrollBar methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:10'!
buttonExtent
	^ self bounds isWide
		ifTrue: [11 @ self innerBounds height]
		ifFalse: [self innerBounds width @ 11]! !

!ScrollBar methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:10'!
expandSlider
	"Compute the new size of the slider (use the old sliderThickness as a minimum)."
	| r |
	r _ self totalSliderArea.
	slider extent: (self bounds isWide
		ifTrue: [((r width * interval) asInteger max: self sliderThickness) @ slider height]
		ifFalse: [slider width @ ((r height * interval) asInteger max: self sliderThickness)])! !

!ScrollBar methodsFor: 'geometry' stamp: 'jcg 7/1/20!
01 23:10'!
totalSliderArea
	^ self bounds isWide
		ifTrue: [upButton topRight corner: downButton bottomLeft]
		ifFalse: [upButton bottomLeft corner: downButton topRight]! !

!ScrollBar methodsFor: 'scrolling' stamp: 'jcg 7/1/2001 23:10'!
setNextDirectionFromEvent: event

	nextPageDirection _ self bounds isWide ifTrue: [
		event cursorPoint x >= slider center x
	]
	ifFalse: [
		event cursorPoint y >= slider center y
	]

! !


!SpeakerMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 23:02'!
addGraphic

	| graphic |
	graphic _ SketchMorph withForm: self speakerGraphic.
	graphic position: self center - (graphic extent // 2).
	self addMorph: graphic.
! !


!StarSqueakMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:40'!
display
	"Display this world on the Display. Used for debugging."

	| c |
	c _ FormCanvas extent: (dimensions * pixelsPerPatch) depth: 32.
	c _ c copyOffset: self position negated.
	self drawOn: c.
	c form display.

! !

!StarSqueakMorph methodsFor: 'dra!
wing' stamp: 'jcg 7/1/2001 23:40'!
drawOn: aCanvas
	"Display this StarSqueak world."

	| tmpForm bitBlt t |
	"copy the patches form"
	tmpForm _ patchForm deepCopy.

	"draw patchVariableToDisplay on top of tmpForm as translucent color"
	self displayPatchVariableOn: tmpForm color: Color yellow shift: logPatchVariableScale.

	"draw turtles on top of tmpForm"
	bitBlt _ (BitBlt toForm: tmpForm)
		clipRect: tmpForm boundingBox;
		combinationRule: Form over.
	1 to: turtles size do: [:i |
		t _ turtles at: i.
		bitBlt
			destX: (pixelsPerPatch * t x truncated)
			destY: (pixelsPerPatch * t y truncated)
			width: pixelsPerPatch
			height: pixelsPerPatch.
		bitBlt
			fillColor: t color;
			copyBits].

	"display tmpForm"
	aCanvas paintImage: tmpForm at: self position.

! !


!StretchyImageMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:24'!
drawOn: aCanvas
| t |
"
Smalltalk at: #Q4 put: OrderedCollection new.
"
	form ifNil: [form _ (Form extent: 32 at 32 depth: 8) fillColo!
r: Color green].
	(cache isNil or: [cache extent ~= self extent]) ifTrue: [
		t _ [cache _ Form extent: self extent depth: aCanvas depth.
		form displayInterpolatedIn: cache boundingBox on: cache] timeToRun.
		"Q4 add: {t. form. cache}."
	].
	aCanvas paintImage: cache at: self position.
! !


!StringMorph methodsFor: 'accessing' stamp: 'jcg 12/31/2001 15:59'!
fitContents

	| scanner newBounds boundsChanged |
	scanner _ DisplayScanner quickPrintOn: Display box: Display boundingBox font: self fontToUse.
	newBounds _ (((scanner stringWidth: contents) max: self minimumWidth)  @ scanner lineHeight).
	boundsChanged _ self extent ~= newBounds.
	self extent: newBounds.		"default short-circuits if bounds not changed"
	boundsChanged ifFalse: [self changed]! !

!StringMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:50'!
drawOn: aCanvas

	aCanvas text: contents bounds: self bounds font: self fontToUse color: color.! !


!DropDownChoiceMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001!
 22:51'!
drawOn: aCanvas

	aCanvas text: contents bounds: (self bounds insetBy: 2)  font: self fontToUse color: color.

	border ifNotNil: [aCanvas frameAndFillRectangle: self bounds
		fillColor: Color transparent
		borderWidth: 1
		borderColor: Color black].

	aCanvas
			paintImage: SubMenuMarker
			at: (self right - 8 @ ((self top + self bottom - SubMenuMarker height) // 2))! !


!IndentingListItemMorph methodsFor: 'drawing' stamp: 'jcg 12/31/2001 15:28'!
drawOn: aCanvas

	| tRect sRect columnRect columnScanner columnData columnLeft colorToUse |

	tRect := self toggleRectangle.
	sRect := self bounds withLeft: tRect right + 3.
	self drawToggleOn: aCanvas in: tRect.
	colorToUse _ complexContents preferredColor ifNil: [color].
	(container columns isNil or: [(contents asString indexOf: Character tab) = 0]) 
		ifTrue: [
			aCanvas 
				text: contents asString 
				bounds: sRect 
				font: self fontToUse 
				color: colorToUse] 		
		ifFalse: [
			columnLeft _ sRect left.
			colum!
nScanner _ ReadStream on: contents asString.
			container columns do: [:width |
				columnRect _ columnLeft @ sRect top extent: width @ sRect height.
				columnData _ columnScanner upTo: Character tab.
				columnData isEmpty ifFalse: [
					aCanvas 
						text: columnData 
						bounds: columnRect 
						font: self fontToUse 
						color: colorToUse].
			columnLeft _ columnRect right + 5]]! !

!IndentingListItemMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:51'!
toggleRectangle

	| h |
	h _ self height.
	^(self left + (12 * indentLevel)) @ self top extent: 12 at h! !


!IndentingListParagraphMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:52'!
drawToggleOn: aCanvas in: aRectangle

	| aForm |

	aCanvas 
		fillRectangle: (self bounds withRight: aRectangle right)
		color: container color.
	complexContents hasContents ifFalse: [^self].
	aForm _ isExpanded 
		ifTrue: [container expandedForm]
		ifFalse: [container notExpandedForm].
	^aCanvas 
		paintI!
mage: aForm 
		at: aRectangle topLeft
! !

!IndentingListParagraphMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:52'!
textMorphBounds

	^(self bounds withRight: self right - 4)
		 withLeft: self textMorphLeft.
! !


!PDAChoiceMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:51'!
drawOn: aCanvas

	| offset |
	offset _ 4@(self height - self fontToUse height // 2).
	aCanvas frameAndFillRectangle: self bounds fillColor: backgroundColor
			borderWidth: 1 borderColor: Color black.
	aCanvas text: contents
			bounds: ((self bounds translateBy: offset) intersect: self bounds)
			font: self fontToUse color: Color black.
! !


!SystemWindow methodsFor: 'initialization' stamp: 'jcg 12/31/2001 16:00'!
addLabel
	"Add a label latterly.  Does not yet get layouts right"

	| aFont |
	label _ StringMorph contents: (labelString ifNil: ['Untitled'])
				font: Preferences windowTitleFont emphasis: 1.

		"Add collapse box so #labelHeight will work"
		aFont _ Prefere!
nces standardButtonFont.
		collapseBox _ SimpleButtonMorph new borderWidth: 0;
				label: 'O' font: aFont; color: Color transparent;
				actionSelector: #collapseOrExpand; target: self; extent: 14 at 14;
				setBalloonText: 'collapse this window'.
		stripes _ Array with: (RectangleMorph newBounds: self bounds)  "see extent:"
					with: (RectangleMorph newBounds: self bounds).

		self addLabelArea.
		labelArea addMorph: (stripes first borderWidth: 1).
		labelArea addMorph: (stripes second borderWidth: 2).
		self setLabelWidgetAllowance.
		self addCloseBox.
		self addMenuControl.
		labelArea addMorph: label.
		labelArea addMorph: collapseBox.

		self setFramesForLabelArea.
		label on: #mouseDown send: #relabelEvent: to: self.
		Preferences noviceMode ifTrue:
			[closeBox ifNotNil: [closeBox setBalloonText: 'close window'].
			menuBox ifNotNil: [menuBox setBalloonText: 'window menu'].
			collapseBox ifNotNil: [collapseBox setBalloonText: 'collapse/expand window']]! !

!SystemWindo!
w methodsFor: 'initialization' stamp: 'jcg 12/31/2001 16:02'!
initialize
	"Initialize a system window.  Add label, stripes, etc., if desired"

	| aFont |
	super initialize.
	allowReframeHandles := true.
	labelString ifNil: [labelString _ 'Untitled Window'].
	isCollapsed _ false.
	activeOnlyOnTop _ true.
	paneMorphs _ Array new.
	Preferences alternativeWindowLook ifFalse:[
		borderColor _ Color black.
		borderWidth _ 1.
		color _ Color black.
	] ifTrue:[
		borderColor _ #raised.
		borderWidth _ 2.
		color _ Color white.
	].
	self layoutPolicy: ProportionalLayout new.

	self wantsLabel ifTrue:
		[label _ StringMorph new contents: labelString;
				font: Preferences windowTitleFont emphasis: 1.

		"Add collapse box so #labelHeight will work"
		aFont _ Preferences standardButtonFont.
		collapseBox _ SimpleButtonMorph new borderWidth: 0;
				label: 'O' font: aFont; color: Color transparent;
				actionSelector: #collapseOrExpand; target: self; extent: 14 at 14;
				setBalloonText: 'co!
llapse this window'.

		stripes _ Array with: (RectangleMorph newBounds: self bounds)  "see extent:"
					with: (RectangleMorph newBounds: self bounds).

		self addLabelArea.

		labelArea addMorph: (stripes first borderWidth: 1).
		labelArea addMorph: (stripes second borderWidth: 2).
		self setLabelWidgetAllowance.
		self addCloseBox.
		self addMenuControl.
		labelArea addMorph: label.
		self wantsExpandBox ifTrue: [self addExpandBox].
		labelArea addMorph: collapseBox.

		self setFramesForLabelArea.
		Preferences clickOnLabelToEdit ifTrue:
			[label on: #mouseDown send: #relabel to: self].
		Preferences noviceMode ifTrue:
			[closeBox ifNotNil: [closeBox setBalloonText: 'close window'].
			menuBox ifNotNil: [menuBox setBalloonText: 'window menu'].
			collapseBox ifNotNil: [collapseBox setBalloonText: 'collapse/expand window']]].
	self on: #mouseEnter send: #spawnReframeHandle: to: self.
	self on: #mouseLeave send: #spawnReframeHandle: to: self.

	self extent: 300 at 200.
	must!
NotClose _ false.
	updatablePanes _ Array new.! !

!SystemWindow methodsFor: 'geometry' stamp: 'jcg 12/31/2001 15:50'!
extent: aPoint 
	"Set the receiver's extent to value provided. Respect my minimumExtent."

	| newExtent |
	newExtent _ self isCollapsed
		ifTrue: [aPoint]
		ifFalse: [aPoint max: self minimumExtent].
	newExtent = self extent ifTrue: [^ self].

	isCollapsed
		ifTrue: [super extent: newExtent x @ (self labelHeight + 2)]
		ifFalse: [super extent: newExtent].
	labelArea ifNotNil:
		[self setStripeColorsFrom: self paneColorToUse.
		label fitContents; setWidth: (label width min: self width - self labelWidgetAllowance).
		label layoutFrame leftOffset: label width negated // 2].
	isCollapsed
		ifTrue: [collapsedFrame _ self bounds]
		ifFalse: [fullFrame _ self bounds]! !

!SystemWindow methodsFor: 'label' stamp: 'jcg 7/1/2001 23:14'!
setLabel: aString
	| frame |
	labelString _ aString.
	label ifNil: [^ self].
	label contents: aString.
	self labelWidgetAllowance.  "S!
ets it if not already"
	self isCollapsed
		ifTrue: [self extent: (label width + labelWidgetAllowance) @ (self labelHeight + 2)]
		ifFalse: [label fitContents; setWidth: (label width min: self width - labelWidgetAllowance).
				label align: label bounds topCenter with: self bounds topCenter + (0 at borderWidth).
				collapsedFrame ifNotNil:
					[collapsedFrame _ collapsedFrame withWidth: label width + labelWidgetAllowance]].
	frame _ LayoutFrame new.
	frame leftFraction: 0.5; topFraction: 0; leftOffset: label width negated // 2.
	label layoutFrame: frame.
! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'jcg 7/1/2001 23:11'!
getBoundsWithFlex
	"Return the lastest bounds rectangle with origin forced to global coordinates"

	self isFlexed
		ifTrue: [^ ((owner transform localPointToGlobal: self topLeft)
										extent: self extent)]
		ifFalse: [^ self bounds].
! !

!SystemWindow methodsFor: 'top window' stamp: 'jcg 7/1/2001 23:14'!
activateAndForceLabelToShow
	self activa!
te.
	self top < 0 ifTrue:
		[self position: (self position x @ 0)]! !

!SystemWindow methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:11'!
areasRemainingToFill: aRectangle
	| areas |
	(areas _ super areasRemainingToFill: aRectangle) isEmpty
		ifTrue: [^ areas "good news -- complete occlusion"].
	"Check for special case that this is scrollbar damage"
	((self topLeft - (14 at 0) corner: self bottomRight) containsRect: aRectangle) ifTrue:
		[paneMorphs do: [:p | ((p isKindOf: ScrollPane) and: [p scrollBarFills: aRectangle])
							ifTrue: [^ Array new]]].
	^ areas! !


!TTSampleFontMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:15'!
drawOn: aCanvas
	| origin extent offset |
	(font isNil) 
		ifTrue:[^aCanvas frameRectangle: self bounds color: Color black].
	origin _ self position asIntegerPoint.
	extent _ self extent asIntegerPoint.
	0 to: 16 do:[:i|
		offset _ (extent x * i // 16) @ (extent y * i // 16).
		aCanvas line: origin x @ (origin y + offset y) 
				to: (origin x + exten!
t x) @ (origin y + offset y)
				width: borderWidth color: borderColor.
		aCanvas line: (origin x + offset x) @ origin y 
				to: (origin x + offset x) @ (origin y + extent y)
				width: borderWidth color: borderColor.
	].
	aCanvas asBalloonCanvas preserveStateDuring:[:balloonCanvas|
		balloonCanvas transformBy: self transform.
		balloonCanvas aaLevel: self smoothing.
		self drawCharactersOn: balloonCanvas.
	].! !


!TTSampleStringMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:15'!
drawOn: aCanvas
	| xStart glyph |
	(font isNil or:[string isNil or:[string isEmpty]]) 
		ifTrue:[^aCanvas frameRectangle: self bounds color: Color black].
	xStart _ 0.
	aCanvas asBalloonCanvas preserveStateDuring:[:balloonCanvas|
		balloonCanvas transformBy: self transform.
		balloonCanvas aaLevel: self smoothing.
		string do:[:char|
			glyph _ font at: char.
			balloonCanvas preserveStateDuring:[:subCanvas|
				subCanvas transformBy: (MatrixTransform2x3 withOffset: xStart at 0).
				subCanvas 
!
					drawGeneralBezierShape: glyph contours
					color: color 
					borderWidth: borderWidth 
					borderColor: borderColor].
			xStart _ xStart + glyph advanceWidth.
		].
	].! !

!TTSampleStringMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:16'!
computeTransform
	| cy |
	cy _ self top + self bottom * 0.5.
	transform _ MatrixTransform2x3 
			transformFromLocal: (ttBounds insetBy: borderWidth negated)
			toGlobal: self bounds.
	transform _ transform composedWithGlobal:(MatrixTransform2x3 withOffset: 0 at cy negated).
	transform _ transform composedWithGlobal:(MatrixTransform2x3 withScale: 1.0 at -1.0).
	transform _ transform composedWithGlobal:(MatrixTransform2x3 withOffset: 0 at cy).
	^transform! !


!TextMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:39'!
drawNullTextOn: aCanvas
	"make null text frame visible"

	aCanvas fillRectangle: self bounds color: 
		((Color black) alpha: 0.1).
! !

!TextMorph methodsFor: 'drawing' stamp: 'jcg 9/4/2001 10:10'!
drawOn: aCanvas
	| faux!
Bounds |
	self setDefaultContentsIfNil.
	super drawOn: aCanvas.  "Border and background if any"
	false ifTrue: [self debugDrawLineRectsOn: aCanvas].  "show line rects for debugging"
	self startingIndex > text size
		ifTrue: [self drawNullTextOn: aCanvas]
		ifFalse: ["Hack here:  The canvas expects bounds to carry the location
				of the text, but we also need to communicate clipping."
				fauxBounds _ self topLeft corner: self innerBounds bottomRight.
				aCanvas paragraph: self paragraph bounds: fauxBounds color: color].
! !

!TextMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:39'!
bounds
	container ifNil: [^ super bounds].
	^ container bounds ifNil: [super bounds]! !

!TextMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:39'!
textBounds
	^ self bounds! !

!TextMorph methodsFor: 'private' stamp: 'jcg 9/4/2001 10:10'!
fit
	"Adjust my bounds to fit the text.  Should be a no-op if autoFit is not specified.
	Required after the text changes,
	or if wrapFlag is true and!
 the user attempts to change the extent."
	| newExtent para cBounds lastOfLines heightOfLast |
	self isAutoFit ifTrue:
		[newExtent _ (self paragraph extent max: 9 at textStyle lineGrid) + (0 at 2).
		newExtent _ newExtent + (2*borderWidth).
		margins ifNotNil: [newExtent _ ((0 at 0 extent: newExtent) expandBy: margins) extent].
		newExtent ~= self extent ifTrue:
			[(container == nil and: [successor == nil]) ifTrue:
				[para _ paragraph.  "Save para (layoutChanged smashes it)"
				super extent: newExtent.
				paragraph _ para]].
		container notNil & successor isNil ifTrue:
			[cBounds _ container bounds truncated.
			"23 sept 2000 - try to allow vertical growth"
			lastOfLines _ self paragraph lines last.
			heightOfLast _ lastOfLines bottom - lastOfLines top.
			(lastOfLines last < text size and: 
					[lastOfLines bottom + heightOfLast >= self bottom]) ifTrue:
				[container releaseCachedState.
				cBounds _ cBounds origin corner: cBounds corner + (0 at heightOfLast)].
			self priva!
teBounds: cBounds]].

	"These statements should be pushed back into senders"
	self paragraph positionWhenComposed: self position.
	successor ifNotNil:
		[successor predecessorChanged].
	self changed. "Too conservative: only paragraph composition
					should cause invalidation."
! !


!ShowEmptyTextMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:40'!
drawOn: aCanvas
	self setDefaultContentsIfNil.
	aCanvas paragraph: self paragraph bounds: self bounds color: color.
! !


!TextMorphForEditView methodsFor: 'miscellaneous' stamp: 'jcg 7/1/2001 23:40'!
drawNullTextOn: aCanvas
	"Just run the normal code to show selection in a window"
	aCanvas paragraph: self paragraph bounds: self bounds color: color
! !


!ThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'jcg 7/1/2001 22:38'!
state: newState
	"Change the image and invalidate the rect."

	newState == state ifTrue: [^ self].
	state _ newState.
	self invalidRect: self bounds.	"All three images must be the same siz!
e"! !

!ThreePhaseButtonMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:39'!
drawOn: aCanvas

	state == #off ifTrue: [
		offImage ifNotNil: [aCanvas paintImage: offImage at: self bounds origin]].
	state == #pressed ifTrue: [
		pressedImage ifNotNil: [aCanvas paintImage: pressedImage at: self bounds origin]].
	state == #on ifTrue: [
		image ifNotNil: [aCanvas paintImage: image at: self bounds origin]].! !

!ThreePhaseButtonMorph methodsFor: 'geometry' stamp: 'jcg 12/31/2001 15:50'!
extent: aPoint
	"Do it normally"
	
	self changed.
	self privateBounds: (self position extent: aPoint).
	self layoutChanged.
	self changed.
! !


!TickIndicatorMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:17'!
drawOn: aCanvas
	| r center cc deg |
	super drawOn: aCanvas.
	corners ifNil:[
		r _ (self bounds topCenter - self center) r - 2.
		corners _ Array new: 32.
		1 to: corners size do:[:i|
			deg _ 360.0 / corners size * (i-1).
			corners at: i put: (Point r: r degrees: deg-90) asIntege!
rPoint]].
	index _ index \\ corners size.
	cc _ color darker.
	center _ self center.
	1 to: corners size by: 4 do:[:i|
		aCanvas fillRectangle: (center + (corners at: i)-2  extent: 4 at 4) color: cc.
	].
	cc _ cc darker.
	aCanvas line: center to: center + (corners at: index + 1) width: 2 color: cc.! !


!TileMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:25'!
line1: line1 line2: line2

	| m1 m2 desiredW |
	self removeAllMorphs.
	m1 _ StringMorph contents: line1 font: ScriptingSystem fontForTiles.
	m2 _ StringMorph contents: line2 font: ScriptingSystem fontForTiles.
	desiredW _ (m1 width max: m2 width) + 6.
	self extent: (desiredW max: self minimumWidth) @ self class defaultH.
	m1 position: (self center x - (m1 width // 2) + 1)@(self top + 1).
	m2 position: (self center x - (m2 width // 2) + 1)@(m1 bottom - 2).
	self addMorph: m1; addMorph: m2.
! !

!TileMorph methodsFor: 'private' stamp: 'jcg 12/31/2001 15:52'!
test
	| pos hh |
	"Set the position of all my submorphs.  Comp!
ute my bounds.  Caller must call layoutChanged or set fullBounds to nil."

	fullBounds ifNil: [
		pos _ self position.
		self submorphsDo: [:sub | 
			hh _ (self class defaultH - sub height) // 2.	"center in Y"
			sub privateBounds: (pos + (2 at hh) extent: sub extent).
			pos x: (sub right min: 1200)].	"2 pixels spacing on left"
		self privateBounds: (self position corner: pos + (2 @ self class defaultH)).
		fullBounds _ self bounds.
		].
	owner class == TilePadMorph ifTrue: [owner bounds: self bounds].
	^ fullBounds! !


!ColorTileMorph methodsFor: 'other' stamp: 'jcg 7/1/2001 23:25'!
addColorSwatch

	| m1 m2 desiredW |
	m1 _ StringMorph contents: 'color' font: (StrikeFont familyName: #NewYork size: 12).
	m2 _ Morph new extent: 12 at 8; color: (Color r: 0.8 g: 0 b: 0).
	desiredW _ m1 width + 6.
	self extent: (desiredW max: self basicWidth) @ self class defaultH.
	m1 position: (self center x - (m1 width // 2)) @ (self top + 1).
	m2 position: (self center x - (m2 width // 2)) @ (m!
1 bottom - 1).
	self addMorph: m1; addMorph: m2.
	colorSwatch _ m2! !


!ColorSeerTile methodsFor: 'initialization' stamp: 'jcg 12/31/2001 15:20'!
initialize

	| m1 m2 desiredW wording |
	super initialize.
	self removeAllMorphs.	"get rid of the parts of a regular Color tile"
	type _ #operator.
	operatorOrExpression _ #color:sees:.
	wording _ (Vocabulary eToyVocabulary methodInterfaceAt: operatorOrExpression ifAbsent: []) elementWording.
	m1 _ StringMorph contents: wording font: ScriptingSystem fontForTiles.
	m2 _ Morph new extent: 12 at 8; color: (Color r: 0.8 g: 0 b: 0).
	desiredW _ m1 width + 6.
	self extent: (desiredW max: self basicWidth) @ self class defaultH.
	m1 position: (self center x - (m1 width // 2)) @ (self top + 5).
	m2 position: (self center x - (m2 width // 2) + 3) @ (self top + 8).
	self addMorph: m1; addMorphFront: m2.
	colorSwatch _ m2.
	! !


!TinyPaint methodsFor: 'events' stamp: 'jcg 7/1/2001 23:37'!
mouseDown: evt

	lastMouse _ evt cursorPoint.
	brush dra!
wFrom: lastMouse - self position to: lastMouse - self position.
	self invalidRect:
		((lastMouse - brush sourceForm extent) corner:
		 (lastMouse + brush sourceForm extent)).
! !

!TinyPaint methodsFor: 'events' stamp: 'jcg 7/1/2001 23:37'!
mouseMove: evt

	| p |
	p _ evt cursorPoint.
	p = lastMouse ifTrue: [^ self].
	brush drawFrom: lastMouse - self position to: p - self position.
	self invalidRect: (
		((lastMouse min: p) - brush sourceForm extent) corner:
		((lastMouse max: p) + brush sourceForm extent)).
	lastMouse _ p.
! !


!TransformMorph methodsFor: 'geometry' stamp: 'jcg 12/31/2001 15:52'!
containsPoint: aPoint
	(self bounds containsPoint: aPoint) ifFalse: [^ false].
	self hasSubmorphs
		ifTrue: [self submorphsDo: 
					[:m | (m containsPoint: (transform globalPointToLocal: aPoint))
							ifTrue: [^ true]].
				^ false]
		ifFalse: [^ true]! !

!TransformMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:50'!
fullBounds
	"Overridden to clip submorph hit detection !
to my bounds."
	"It might be better to override doLayoutIn:, and remove this method"

	fullBounds ifNotNil:[^ fullBounds].
	fullBounds _ self bounds.
	submorphs do: [:m| m ownerChanged].
	^ fullBounds! !

!TransformMorph methodsFor: 'change reporting' stamp: 'jcg 7/1/2001 22:49'!
invalidRect: damageRect from: aMorph
	"Translate damage reports from submorphs by the scrollOffset."
	aMorph == self
		ifTrue:[super invalidRect: damageRect from: self]
		ifFalse:[super invalidRect: (((transform localBoundsToGlobal: damageRect) intersect: self bounds) expandBy: 1) from: self].! !


!TransformationMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 22:50'!
adjustAfter: changeBlock 
	"Cause this morph to remain cetered where it was before, and
	choose appropriate smoothing, after a change of scale or rotation."
	| oldRefPos |
	oldRefPos _ self referencePosition.
	changeBlock value.
	self chooseSmoothing.
	self penUpWhile: [self position: self position + (oldRefPos - self referencePositio!
n)].
	self layoutChanged.
	owner ifNotNil: [owner invalidRect: self bounds]
! !

!TransformationMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 22:12'!
replaceSubmorph: oldMorph by: newMorph
	| t b |
	t _ transform.
	b _ self bounds.
	super replaceSubmorph: oldMorph by: newMorph.
	transform _ t.
	self privateBounds: b.
	self layoutChanged! !

!TransformationMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:50'!
computeBounds
	self hasSubmorphs ifTrue: [
		self privateBounds: 
			((transform localBoundsToGlobal:
				(Rectangle merging:
					(self submorphs collect: [:m | m fullBounds]))) truncated
				expandBy: 1)].
	fullBounds _ self bounds.! !


!BOBTransformationMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:50'!
adjustAfter: changeBlock 
	"Cause this morph to remain cetered where it was before, and
	choose appropriate smoothing, after a change of scale or rotation."
	| |

		"oldRefPos _ self referencePosition."
	changeBlock value.
	self chooseSmoothin!
g.
		"self penUpWhile: [self position: self position + (oldRefPos - self referencePosition)]."
	self layoutChanged.
	owner ifNotNil: [owner invalidRect: self bounds]
! !

!BOBTransformationMorph methodsFor: 'as yet unclassified' stamp: 'jcg 12/31/2001 15:18'!
extent: aPoint

	| newExtent |

	newExtent _ aPoint truncated.
	self extent = newExtent ifTrue: [^self].
	self privateBounds: (self position extent: newExtent).
	self recomputeExtent.

! !

!BOBTransformationMorph methodsFor: 'as yet unclassified' stamp: 'jcg 12/31/2001 15:19'!
extentFromParent: aPoint

	| newExtent |

	submorphs isEmpty ifTrue: [^self extent: aPoint].
	newExtent _ aPoint truncated.
	self privateBounds: (self position extent: newExtent).
	newExtent _ self recomputeExtent.
	newExtent ifNil: [^self].
	self privateBounds: (self position extent: newExtent).

! !


!TransformationB2Morph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:50'!
adjustAfter: changeBlock 

	"same as super, but without ref!
erence position stuff"

	changeBlock value.
	self chooseSmoothing.
	self layoutChanged.
	owner ifNotNil: [owner invalidRect: self bounds]
! !

!TransformationB2Morph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:50'!
extent: aPoint

	| newExtent |

	newExtent _ aPoint truncated.
	self extent = newExtent ifTrue: [^self].
	self privateBounds: (self topLeft extent: newExtent).
	"self recomputeExtent."

! !


!TransitionMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:53'!
initiateReplacement
	| n |
	startForm _ effect = #dissolve
		ifTrue: [(startMorph imageForm: 16 forRectangle: self bounds) offset: 0 at 0]
		ifFalse: [(startMorph imageFormForRectangle: self bounds) offset: 0 at 0].
	endForm _ (endMorph imageFormForRectangle: self bounds) offset: 0 at 0.

	nSteps == nil ifTrue:
		[self nSteps: 30 stepTime: 10.
		(#(zoom pageForward pageBack) includes: effect) ifTrue:
			[n _ 20 * 100000 // self bounds area min: 20 max: 4.
			self nSteps: n stepTime: 10].
		(#disso!
lve = effect) ifTrue:
			[n _ 20 * 50000 // self bounds area min: 20 max: 4.
			self nSteps: n stepTime: 10]].

	startBlock value.  "with forms in place there should b no further delay."
	self arrangeToStartStepping.
! !

!TransitionMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:53'!
drawPageBackOn: aCanvas
	"endForm grows in the given direction, overlaying endForm."
	| offset growRect scale |
	aCanvas drawImage: startForm at: self position.

	offset _ self stepFrom: self extent * direction negated to: 0 at 0.
	growRect _ (self bounds translateBy: offset) intersect: self bounds.
	scale _ growRect extent asFloatPoint / self extent.
	aCanvas drawImage: (endForm magnify: endForm boundingBox by: scale smoothing: 1)
		at: growRect topLeft.

	((growRect translateBy: direction) areasOutside: growRect) do:
		[:r | aCanvas fillRectangle: r color: Color black].
! !

!TransitionMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:52'!
drawPageForwardOn: aCanvas
	"startForm shrinks in !
the given direction, revealing endForm."
	| offset shrinkRect scale |
	aCanvas drawImage: endForm at: self position.

	offset _ self stepFrom: 0 at 0 to: self extent * direction.
	shrinkRect _ (self bounds translateBy: offset) intersect: self bounds.
	scale _ shrinkRect extent asFloatPoint / self extent.
	aCanvas drawImage: (startForm magnify: startForm boundingBox by: scale smoothing: 1)
		at: shrinkRect topLeft.

	((shrinkRect translateBy: direction negated) areasOutside: shrinkRect) do:
		[:r | aCanvas fillRectangle: r color: Color black].
! !

!TransitionMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:53'!
drawZoomOn: aCanvas
	"Zoom in: endForm expands overlaying startForm.
	Zoom out: startForm contracts revealing endForm."
	| box innerForm outerForm boxExtent scale |
	direction = #in
		ifTrue: [innerForm _ endForm.  outerForm _ startForm.
				boxExtent _ self stepFrom: 0 at 0 to: self extent]
		ifFalse: [innerForm _ startForm.  outerForm _ endForm.
				boxExtent _ self st!
epFrom: self extent to: 0 at 0].

	aCanvas drawImage: outerForm at: self position.

	box _ Rectangle center: self center extent: boxExtent.
	scale _ box extent asFloatPoint / self extent.
	aCanvas drawImage: (innerForm magnify: innerForm boundingBox by: scale smoothing: 1)
		at: box topLeft.

	((box expandBy: 1) areasOutside: box) do:
		[:r | aCanvas fillRectangle: r color: Color black].
! !

!TransitionMorph methodsFor: 'change reporting' stamp: 'jcg 7/1/2001 22:53'!
changed
	"The default (super) method is, generally much slower than need be, since many transitions only change part of the screen on any given step of the animation.  The purpose of this method is to effect some of those savings."
	| loc box boxPrev h w |
	(stepNumber between: 1 and: nSteps) ifFalse: [^ super changed].
	effect = #slideBoth ifTrue: [^ super changed].
	effect = #slideOver ifTrue:
		[loc _ self stepFrom: self position - (self extent * direction) to: self position.
		^ self invalidRect: (((loc extent!
: self extent) expandBy: 1) intersect: self bounds)].
	effect = #slideAway ifTrue:
		[loc _ self prevStepFrom: self position to: self position + (self extent * direction).
		^ self invalidRect: (((loc extent: self extent) expandBy: 1) intersect: self bounds)].
	effect = #slideBorder ifTrue:
		[box _ endForm boundingBox translateBy:
				(self stepFrom: self topLeft - (self extent * direction) to: self topLeft).
		boxPrev _ endForm boundingBox translateBy:
				(self prevStepFrom: self topLeft - (self extent * direction) to: self topLeft).
		^ self invalidate: (box expandBy: 1) areasOutside: boxPrev].
	effect = #pageForward ifTrue:
		[loc _ self prevStepFrom: 0 at 0 to: self extent * direction.
		^ self invalidRect: (((self bounds translateBy: loc) expandBy: 1) intersect: self bounds)].
	effect = #pageBack ifTrue:
		[loc _ self stepFrom: self extent * direction negated to: 0 at 0.
		^ self invalidRect: (((self bounds translateBy: loc) expandBy: 1) intersect: self bounds)].
	effect = !
#frenchDoor ifTrue:
		[h _ self height. w _ self width.
		direction = #in ifTrue:
			[box _ Rectangle center: self center
							extent: (self stepFrom: 0 at h to: self extent).
			boxPrev _ Rectangle center: self center
							extent: (self prevStepFrom: 0 at h to: self extent).
			^ self invalidate: (box expandBy: 1) areasOutside: boxPrev].
		direction = #out ifTrue:
			[box _ Rectangle center: self center
							extent: (self stepFrom: self extent to: 0 at h).
			boxPrev _ Rectangle center: self center
							extent: (self prevStepFrom: self extent to: 0 at h).
			^ self invalidate: (boxPrev expandBy: 1) areasOutside: box].
		direction = #inH ifTrue:
			[box _ Rectangle center: self center
							extent: (self stepFrom: w at 0 to: self extent).
			boxPrev _ Rectangle center: self center
							extent: (self prevStepFrom: w at 0 to: self extent).
			^ self invalidate: (box expandBy: 1) areasOutside: boxPrev].
		direction = #outH ifTrue:
			[box _ Rectangle center: self center
							extent:!
 (self stepFrom: self extent to: w at 0).
			boxPrev _ Rectangle center: self center
							extent: (self prevStepFrom: self extent to: w at 0).
			^ self invalidate: (boxPrev expandBy: 1) areasOutside: box]].
	effect = #zoomFrame ifTrue:
		[direction = #in ifTrue:
			[box _ Rectangle center: self center
							extent: (self stepFrom: 0 at 0 to: self extent).
			boxPrev _ Rectangle center: self center
							extent: (self prevStepFrom: 0 at 0 to: self extent).
			^ self invalidate: (box expandBy: 1) areasOutside: boxPrev].
		direction = #out ifTrue:
			[box _ Rectangle center: self center
							extent: (self stepFrom: self extent to: 0 at 0).
			boxPrev _ Rectangle center: self center
							extent: (self prevStepFrom: self extent to: 0 at 0).
			^ self invalidate: (boxPrev expandBy: 1) areasOutside: box]].
	effect = #zoom ifTrue:
		[box _ Rectangle center: self center extent:
			(direction = #in
				ifTrue: [self stepFrom: 0 at 0 to: self extent]
				ifFalse: [self prevStepFrom: self extent to!
: 0 at 0]).
		^ self invalidRect: ((box expandBy: 1) intersect: self bounds)].
	^ super changed
! !

!TransitionMorph methodsFor: 'change reporting' stamp: 'jcg 7/1/2001 22:54'!
invalidate: box1 areasOutside: box2

	((box1 intersect: self bounds) areasOutside: (box2 intersect: self bounds))
		do: [:r | self invalidRect: r]! !


!TranslucentProgessMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:32'!
drawOn: aCanvas

	| revealPercentage revealingStyle revealingColor revealingBounds revealToggle x baseColor revealTimes secondsRemaining scanner stringToDraw where fontToUse innerBounds |
	
	innerBounds _ self bounds.
	opaqueBackgroundColor ifNotNil: [
		aCanvas 
			frameAndFillRectangle: self bounds
			fillColor: opaqueBackgroundColor
			borderWidth: 8
			borderColor: Color blue.
		innerBounds _ innerBounds insetBy: 8.
	].
	revealTimes _ (self valueOfProperty: #revealTimes) ifNil: [^self].
	revealPercentage _ (revealTimes first / revealTimes second) asFloat.
	reveali!
ngStyle _ self revealingStyle.
	x _ self valueOfProperty: #progressStageNumber ifAbsent: [1].
	baseColor _ Color perform: (#(red blue green magenta cyan yellow) atPin: x).
	revealingColor _ baseColor alpha: 0.2.
	revealingStyle = 3 ifTrue: [	"wrap and change color"
		revealPercentage > 1.0 ifTrue: [
			revealingColor _ baseColor alpha: (0.2 + (revealingStyle / 10) min: 0.5).
		].
		revealPercentage _ revealPercentage fractionPart.
	].
	revealingStyle = 2 ifTrue: [	"peg at 75 and blink"
		revealPercentage > 0.75 ifTrue: [
			revealToggle _ self valueOfProperty: #revealToggle ifAbsent: [true].
			self setProperty: #revealToggle toValue: revealToggle not.
			revealToggle ifTrue: [revealingColor _ baseColor alpha: 0.8.].
		].
		revealPercentage _ revealPercentage min: 0.75.
	].
	revealingBounds _ innerBounds withLeft: innerBounds left + (innerBounds width * revealPercentage) truncated.
	aCanvas 
		fillRectangle: revealingBounds
		color: revealingColor.
	secondsRemaining _ (revea!
lTimes second - revealTimes first / 1000) rounded.
	secondsRemaining > 0 ifTrue: [
		fontToUse _ StrikeFont familyName: 'ComicBold' size: 24.
		scanner _ DisplayScanner
			quickPrintOn: aCanvas form 
			box: innerBounds 
			font: fontToUse 
			color: Color black.
		stringToDraw _ secondsRemaining printString.
		where _ innerBounds corner - ((scanner stringWidth: stringToDraw) @ scanner lineHeight).
		scanner 
			drawString: stringToDraw 
			at: where.
		scanner _ DisplayScanner
			quickPrintOn: aCanvas form 
			box: innerBounds 
			font: fontToUse 
			color: Color white.
		scanner 
			drawString: stringToDraw 
			at: where - (1 at 1).
	]. 


! !


!TwoWayScrollPane methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:06'!
resizeScrollBar
	"used to handle left vs right scrollbar"
	yScrollBar bounds: (self topLeft extent: 16 @ (self height - 16)).
	xScrollBar bounds: ((self left + 16) @ (self bottom - 16)  extent: (self width - 16) @ 16).
! !


!URLMorph methodsFor: 'drawing' stamp: 'j!
cg 12/31/2001 15:56'!
drawOn: aCanvas
	"Draw thumbnail for my page, if it is available. Otherwise, just draw a rectangle." 
	| thumbnail oldExt |

	color == Color transparent 
		ifTrue: ["show thumbnail"
			thumbnail _ self thumbnailOrNil.
			thumbnail
				ifNil: [
					aCanvas 
						frameRectangle: self bounds 
						width: borderWidth 
						color: borderColor.
					aCanvas fillRectangle: (self bounds insetBy: borderWidth) color: color]
				ifNotNil: [
					oldExt _ self extent.
					self privateBounds: (self position extent: thumbnail extent + (2 at 2)).
					aCanvas 
						frameRectangle: self bounds 
						width: borderWidth 
						color: borderColor.
					aCanvas 
						paintImage: thumbnail 
						at: self position + borderWidth.
					oldExt = thumbnail extent ifFalse: [self layoutChanged]]]
		ifFalse: ["show labeled button"
			^ super drawOn: aCanvas]
! !


!UpdatingBooleanStringMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:52'!
mouseUp: evt
	(self bo!
unds containsPoint: evt cursorPoint)
		ifTrue:
			[self contentsClipped: (target perform: getSelector) not asString.
			self informTarget]
		ifFalse:
			[self beep].
	self color: Color black! !


!VeryPickyMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:31'!
drawOn: aCanvas

	aCanvas frameRectangle: self bounds width: 1 color: Color red! !


!WatchMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:17'!
drawOn: aCanvas
	| pHour pMin pSec time |
	time _ Time now.
	pHour _ self radius: 0.6 hourAngle: time hours + (time minutes/60.0).
	pMin _ self radius: 0.72 hourAngle: (time minutes / 5.0).
	pSec _ self radius: 0.8 hourAngle: (time seconds / 5.0).
	time hours < 12
		ifTrue: [self centerColor: Color veryLightGray]
		ifFalse: [self centerColor: Color darkGray].

	antialias ifTrue: [
		aCanvas asBalloonCanvas
			aaLevel: 4;
			drawOval: (self bounds insetBy: borderWidth // 2 + 1) color: self fillStyle
				borderWidth: borderWidth borderColor: borderColor;
			draw!
Oval: (self bounds insetBy: self extent*0.35) color: cColor
				borderWidth: 0 borderColor: Color black;
			drawPolygon: {self center. pHour}
				color: Color transparent borderWidth: 3 borderColor: handsColor;
			drawPolygon: {self center. pMin}
				color: Color transparent borderWidth: 2 borderColor: handsColor;
			drawPolygon: {self center. pSec}
				color: Color transparent borderWidth: 1 borderColor: handsColor]
		ifFalse: [
			super drawOn: aCanvas.
			aCanvas
				fillOval: (self bounds insetBy: self extent*0.35) color: cColor;
				line: self center to: pHour width: 3 color: handsColor;
				line: self center to: pMin width: 2 color: handsColor;
				line: self center to: pSec width: 1 color: handsColor.]
! !


!PDAClockMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:17'!
drawOn: aCanvas

	aCanvas frameAndFillRectangle: self bounds fillColor: backgroundColor
				borderWidth: 1 borderColor: borderColor.
	super drawOn: aCanvas.
! !


!WebPageMorph methodsFo!
r: 'drawing' stamp: 'jcg 7/1/2001 23:06'!
drawOn: aCanvas

		super drawOn: aCanvas.	
		image = nil ifFalse:[aCanvas image: image at: self topLeft].! !


!WheelMorph methodsFor: 'properties' stamp: 'jcg 7/1/2001 23:26'!
isHorizontal
	^ self bounds isWide! !


!WiWPasteUpMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:21'!
viewBox: newViewBox

	| vb |

	worldState resetDamageRecorder.	"since we may have moved, old data no longer valid"
	((vb _ self viewBox) == nil or: [vb ~= newViewBox])
		ifTrue: [worldState canvas: nil].

	worldState viewBox: newViewBox.

	self privateBounds: newViewBox.
	worldState assuredCanvas.
	"Paragraph problem workaround; clear selections to avoid screen droppings:"
	self flag: #arNote. "Probably unnecessary"
	worldState handsDo: [:h | h releaseKeyboardFocus].
	self fullRepaintNeeded.

! !


!MVCWiWPasteUpMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:30'!
position: aPoint
	"Change the position of this morph and and all of its submorp!
hs."

	| delta |
	delta _ aPoint - self topLeft.
	(delta x = 0 and: [delta y = 0]) ifTrue: [^ self].  "Null change"
	self changed.
	self privateFullMoveBy: delta.
	self changed.
! !


!WonderlandCameraControls methodsFor: 'accessing' stamp: 'jcg 7/1/2001 22:41'!
extent: aPoint

	self extent = aPoint ifFalse: [
		self changed.
		self privateBounds: (self topLeft extent: aPoint).
		self layoutChanged.
		self changed].! !


!WonderlandCameraMorph methodsFor: 'debug' stamp: 'jcg 7/1/2001 22:44'!
debugDraw
	Display deferUpdates: false.
	self fullDrawOn: (Display getCanvas).
	Display deferUpdates: false.
	Display forceToScreen: self bounds.! !

!WonderlandCameraMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:45'!
drawAcceleratedOn: aCanvas
	| myRect |
	myRect _ (self bounds: self bounds in: nil) intersect: (0 at 0 extent: DisplayScreen actualScreenSize).
	(myRenderer notNil and:[myRenderer isAccelerated]) ifFalse:[
		myRenderer ifNotNil:[myRenderer destroy].
		myRenderer _ nil.
	!
].
	myRenderer ifNotNil:[
		myRenderer _ myRenderer bufferRect: myRect.
	].
	myRenderer ifNil:[
		myRenderer _ B3DHardwareEngine newIn: myRect.
		myRenderer ifNil:[^self drawSimulatedOn: aCanvas].
	] ifNotNil:[
		myRenderer reset.
	].
	myRenderer viewportOffset: aCanvas origin.
	myRenderer clipRect: aCanvas clipRect.
	myCamera drawSceneBackground ifFalse:[
		myRenderer restoreMorphicBackground: myRect under: self.
	].
	self renderOn: myRenderer.
	outline ifNotNil:[
		self drawAcceleratedOutlineOn: myRenderer.
	].
	myRenderer restoreMorphicForeground: myRect above: self.
	Display addExtraRegion: myRect for: self.! !

!WonderlandCameraMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:48'!
drawAcceleratedOutlineOn: aRenderer
	"Draw a pooh outline on an accelerated renderer."
	| vtxList scale out pt vtx offset z |
	"NOTE: The test below captures two distinct cases.
		#1: The software renderer (which does not support lines)
		#2: The D3D renderer (which does not support line at!
tributes)."
	myRenderer hasFrameBufferAccess ifTrue:[
		^myRenderer provideOverlayCanvasDuring:[:cc| self sketchOn: cc].
	].
	z _ 0.5.
	vtxList _ self outline contents.
	vtxList size < 2 ifTrue:[^self].
	out _ WriteStream on: (B3DVector3Array new: vtxList size * 2).
	out nextPut: vtxList first @ z.
	2 to: vtxList size-1 do:[:i|
		pt _ vtxList at: i.
		vtx _ B3DVector3 x: pt x y: pt y z: z.
		out nextPut: vtx; nextPut: vtx].
	out nextPut: vtxList last @ z.
	out _ out contents.

	offset _ self topLeft + self bottomRight * 0.5 @ 0.
	scale _ (2.0 / self width) @ (-2.0 / self height) @ 1.

	myRenderer reset. "get rid of everything"
	myRenderer material: (B3DMaterial new emission: Color red).
	myRenderer scaleBy: scale.
	myRenderer translateBy: offset negated.
	myRenderer lineWidth: 5.
	myRenderer drawLines: out normals: nil colors: nil texCoords: nil.
! !

!WonderlandCameraMorph methodsFor: 'picking points' stamp: 'jcg 7/1/2001 22:45'!
pickPointInBounds: boundary
	"Chooses a rand!
om point so that this morph lies within the specified bounds"

	| xpos ypos |

	xpos _ (boundary left) + (0 to: ((boundary width) - (self width))) atRandom.
	ypos _ (boundary top) + (0 to: ((boundary height) - (self height))) atRandom.

	^ xpos at ypos.

! !

!WonderlandCameraMorph methodsFor: 'picking points' stamp: 'jcg 7/1/2001 22:45'!
pickPointOnBounds: boundary
	"Chooses a random point so that an edge of this morph lies on the specified bounds"

	| side pos |

	"First choose which side to move the morph to"
	side _ (1 to: 4) atRandom.

	"Now choose where on that side to move to"
	((side = 1) or: [ side = 3 ])
			ifTrue: [ pos _ (0 to: ((boundary height) - (self height))) atRandom]
			ifFalse: [ pos _ (0 to: ((boundary width) - (self width))) atRandom ].

	"Now assemble the point)"
	"left"
	(side = 1) ifTrue: [ ^ (boundary left)@((boundary top) + pos) ].

	"top"
	(side = 2) ifTrue: [ ^ ((boundary left) + pos) @ (boundary top) ].

	"right"
	(side = 3) ifTrue: [ ^ ((boundary !
right) - (self width)) @ ((boundary top) + pos) ].

	"bottom"
	^ ((boundary left) + pos) @ ((boundary bottom) - (self height)).
! !

!WonderlandCameraMorph methodsFor: 'pooh' stamp: 'jcg 12/31/2001 15:59'!
createPoohActor
	| actor pointList box scale center subdivision mesh tex |

	pointList _ self outline.
	pointList reset.
	pointList _ pointList contents.
	pointList size < 2 ifTrue:[
		self clearStroke.
		^errorSound play].

	pointList _ self simplify: pointList.
	pointList _ self smoothen: pointList length: 10.
	pointList _ self regularize: pointList.
	box _ Rectangle encompassing: pointList.
	scale _ self top * 0.5.
	scale _ 1.0 / (scale @ scale negated).
	center _ box origin + box corner * 0.5.
	pointList _ pointList collect: [:each | each - center * scale].
	subdivision _ PoohSubdivision constraintOutline: pointList.
	mesh _ subdivision build3DObject.

	mesh ifNil:[
		errorSound play.
	] ifNotNil:[
		actor _ self getWonderland makeActorNamed: 'sketch'.
		actor setPrope!
rty: #handmade toValue: true;
			setBackfaceCulling: #ccw;
			setMesh: mesh;
			setColor: gray.
		Preferences twoSidedPoohTextures
			ifTrue:[tex _ (Form extent: 256 at 512 depth: 32) asTexture fillColor: Color white]
			ifFalse:[tex _ (Form extent: 256 at 256 depth: 32) asTexture fillColor: Color white].
		actor setTexturePointer: tex.
		actor setComposite: (myCamera getMatrixFromRoot composedWithLocal: (B3DMatrix4x4 withOffset: 0 at 0@2)).
		actor scaleByMatrix: (B3DRotation axis: 0 at 1@0 angle: 90) asMatrix4x4.
		actor rotateByMatrix: (B3DRotation axis: 0 at 1@0 angle:-90) asMatrix4x4.
	].

	self clearStroke.
	self mode: nil.
	Cursor normal show.
! !


!WonderlandEditor methodsFor: 'resizing' stamp: 'jcg 7/1/2001 22:44'!
extent: aPoint

	| newPoint aMorph |

	self extent = aPoint
		ifFalse: [
			self changed.

			newPoint _ aPoint.
			(aPoint x < 370) ifTrue: [ newPoint _ 370@(aPoint y) ].
			(aPoint y < 130) ifTrue: [ newPoint _ (newPoint x)@130 ].

			aMorph _ myActorBrowser getMorph!
.
			aMorph extent: 140@((newPoint y) - 52).
			aMorph position: (self position + (0 at 50)).

			myTabs extent: (newPoint x - 142)@(newPoint y - 4).
			myTabs position: (self position + (142 at 0)).

			self privateBounds: (self topLeft extent: newPoint).
			self layoutChanged.
			self changed.
				].
! !


!WonderlandEditorTabs methodsFor: 'accessing' stamp: 'jcg 7/1/2001 23:23'!
extent: aPoint

	| newPoint |

	self extent = aPoint
		ifFalse: [
			self changed.

			newPoint _ (aPoint x)@(aPoint y - 20).

			myScriptEditor getMorph extent: newPoint.
			myActorViewer extent: newPoint.
			myQuickReference getMorph extent: newPoint.

			self privateBounds: (self topLeft extent: aPoint).
			self layoutChanged.
			self changed
				].
! !


!WonderlandWrapperMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:32'!
drawOn: aCanvas
	| morph |
	morph _ self getCameraMorph.
	morph == nil
		ifTrue:[super drawOn: aCanvas]
		ifFalse:[self computeBounds: morph. "Update bounds from camera"
			!
false ifTrue:["Show a rectangle for the wrappers"
				aCanvas frameRectangle: self bounds color: Color white]]! !

!WonderlandWrapperMorph methodsFor: 'handles' stamp: 'jcg 7/1/2001 23:31'!
growMoveFromHalo: evt with: handle
	| newExtent scale |
	newExtent _ (self pointFromWorld: (evt cursorPoint - self growPositionOffset)) - self topLeft.
	newExtent _ newExtent max: 1 at 1.
	scale _ newExtent r / self extent r.
	evt shiftPressed
		ifTrue:[scale _ B3DVector3 x: scale y: scale z: 1.0]
		ifFalse:[scale _ B3DVector3 x: scale y: scale z: scale].
 	myActor resizeRightNow: scale undoable: false.
	handle position: evt cursorPoint - (handle extent // 2).! !

!WonderlandWrapperMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 22:21'!
computeBounds: morph
	| box |
	box _ myActor getFullBoundsFor: morph getCamera.
	box == nil ifFalse:[self privateBounds: box].! !

ThreePhaseButtonMorph removeSelector: #extent!