PolygonMorph subclass: #BezierMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'CircularReasoning'!
!BezierMorph commentStamp: '<historical>' prior: 0!
!


!BezierMorph methodsFor: 'drawing' stamp: 'TJ 5/3/2006 14:15'!
drawBezier3Shape: aCanvas
	| bCanvas |
	bCanvas := aCanvas asBalloonCanvas aaLevel: 4.
	bCanvas drawBezier3Shape: self getVertices
                                color: self color
                                borderWidth: self borderWidth
                                borderColor: self borderColor.
! !

!BezierMorph methodsFor: 'drawing' stamp: 'TJ 4/28/2006 14:00'!
drawOn: aCanvas 
	"Display the receiver, a spline curve, approximated by straight 
	line segments."
	vertices
		ifNil: [self error: 'vertices was nil, should be an array of points'].
	vertices size = 4
		ifFalse: [self error: 'a cubic bezier curve must have exactly 4 points (two endpoints and two control points'].
	self drawBezier3Shape: aCanvas.! !


!BezierMorph methodsFor: 'editing' stamp: 'TJ 3/29/2006 07:45'!
addHandles
	"Endpoints are yellow circles, control points are red diamonds"
	| handle diamond |
	self removeHandles.
	handles := OrderedCollection new.
	diamond := Array with: 0@-4 with: 4@3 with: 1@9 with: -3@3.
	vertices withIndexDo:
		[:vertPt :vertIndex |
		(vertIndex = 1 or: [vertIndex = vertices size])
		ifTrue:
		[handle := EllipseMorph newBounds: (Rectangle center: vertPt extent: 8@8)
				color: Color yellow.]
		ifFalse:
		[handle := PolygonMorph
				vertices: (diamond collect: [:p | p + (vertPt + (vertices atWrap: vertIndex+1) // 2)])
				color: Color red borderWidth: 1 borderColor: Color black.].
		handle on: #mouseMove send: #dragVertex:event:fromHandle:
				to: self withValue: vertIndex.
		handle on: #mouseUp send: #dropVertex:event:fromHandle:
				to: self withValue: vertIndex.
		self addMorph: handle.
		handles addLast: handle.].
	self changed! !

!BezierMorph methodsFor: 'editing' stamp: 'TJ 3/27/2006 15:01'!
dropVertex: ix event: evt fromHandle: handle
	"Override dropVertex in PolygonMorph to prevent deletion"! !

!BezierMorph methodsFor: 'editing' stamp: 'TJ 3/26/2006 09:15'!
updateHandles
	| oldVert |
	vertices
				withIndexDo: [:vertPt :vertIndex | 

					"Transcript show: 'Control Point '.
					Transcript show: vertIndex.
					Transcript show: ' of '.
					Transcript show: vertices.
					Transcript cr."
					oldVert := handles at: vertIndex.
					oldVert position: vertPt - (oldVert extent // 2).]! !


!BezierMorph methodsFor: 'initialization' stamp: 'TJ 5/2/2006 13:29'!
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ (Color black).! !

!BezierMorph methodsFor: 'initialization' stamp: 'TJ 5/2/2006 11:52'!
defaultBorderWidth
	"answer the default border width style for the receiver"
	^ 2.! !

!BezierMorph methodsFor: 'initialization' stamp: 'TJ 5/2/2006 13:27'!
defaultColor
	"answer the default color/fill style for the receiver"
	^ (Color transparent).! !

!BezierMorph methodsFor: 'initialization' stamp: 'TJ 3/27/2006 15:53'!
initialize
"initialize the state of the receiver"
	super initialize.
""
	vertices := Array
				with: 5 @ 0
				with: 30 @ 10
				with: 10 @ 20
				with: 0 @ 10.
	closed := true.
	smoothCurve := false.
	arrows := #none.
	self computeBounds! !


!BezierMorph methodsFor: 'geometry' stamp: 'TJ 7/3/2006 14:38'!
rotateBy: angle about: center
	"Change orientation of curve without changing heading.  rotateBy rotates points counterclockwise."
	| newVertices |

	newVertices := vertices collect:
		[:vertex | vertex rotateBy: angle about: center ].

	vertices := newVertices.! !

!BezierMorph methodsFor: 'geometry' stamp: 'TJ 4/25/2006 15:07'!
rotateClockWiseBy: angle about: center
	"Change orientation of curve without changing heading.  Angle is negated because rotateBy rotates points counterclockwise."
	| newVertices |

	newVertices := vertices collect:
		[:vertex | vertex rotateBy: (angle negated) about: center ].

	vertices := newVertices.! !

!BezierMorph methodsFor: 'geometry' stamp: 'TJ 4/22/2006 08:24'!
translateBy: delta 
	"Change vertices of curve without changing position."

	| newVertices |

	newVertices := vertices collect:
		[:vertex | vertex translateBy: delta ].

	vertices := newVertices.! !


!BezierMorph methodsFor: 'accessing' stamp: 'TJ 5/2/2006 14:50'!
borderColor
	(super borderColor)
	ifNil: [^ self defaultBorderColor].
	(ByteSymbol = super borderColor class)
	ifNil: [^ self defaultBorderColor].
	((super borderColor) isKindOf: Color orOf: FillStyle) ifTrue: [^ super borderColor].
	^ self defaultBorderColor.
! !

!BezierMorph methodsFor: 'accessing' stamp: 'TJ 5/2/2006 13:56'!
borderWidth
	(super borderWidth)
	ifNil: [^ self defaultBorderWidth].
	^ (super borderWidth).! !

!BezierMorph methodsFor: 'accessing' stamp: 'TJ 5/2/2006 13:56'!
color
	(super color)
	ifNil: [^ self defaultColor].
	^ super color.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

BezierMorph class
	instanceVariableNames: ''!
!BezierMorph class commentStamp: '<historical>' prior: 0!
!


!BezierMorph class methodsFor: 'parts bin' stamp: 'TJ 7/18/2006 07:45'!
descriptionForPartsBin
	^ self partName:	'Bezier Curve'
		categories:		#('Graphics' 'Basic')
		documentation:	'A cubic bezier curve.  Shift-click to get handles and move the vertices and control points.'! !


!BezierMorph class methodsFor: 'instance creation' stamp: 'TJ 3/29/2006 11:05'!
vertices: verts color: lineColor width: lineWidth

	^ BezierMorph vertices: verts
			color: Color transparent borderWidth: lineWidth borderColor: lineColor! !


BezierMorph subclass: #BSplineMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'CircularReasoning'!
!BSplineMorph commentStamp: '<historical>' prior: 0!
Visually, this class links cubic Bezier curves the way PolygonMorph links lines.  When you shift-click on this morph, the knots between the curves show up as yellow circles, just like the vertices between line segments on a PolygonMorph.  For BSplineMorphs that are not closed, endpoints are also yellow circles.  Control points are red diamonds, just like they are for BezierMorphs.

To get this class ready for the parts bin, add capability for adding and deleting BezierCurves the way that lines are added and deleted from PolygonMorphs (clicking on green triangles to add or dragging one vertex over another to delete).  Might make sense to initially give the user an open curve with the option to close it by dragging one endpoint over another.

The BSpline is a bunch of 4-point (2 endpoints, 2 control points) cubic Bezier curves strung together.  It is drawn with drawBezier3Shape, which requires a number of points that is some multiple of 4.  To draw a closed figure with drawBezier3Shape, you need to make its 5th point the same as its 4th point, its 9th point the same as its 8th point, etc, and its last point the same as its first point.

For BSplineMorph, it might be better to have a constructor that just takes 4 + 3n vertices (or 3n vertices for closed BSplines) and duplicates points as needed by drawBezier3Shape.!


!BSplineMorph methodsFor: 'drawing' stamp: 'TJ 4/28/2006 13:59'!
drawOn: aCanvas 
	"Display the receiver, a spline curve, approximated by straight 
	line segments."
	| c |
	c := color.
	vertices
		ifNil: [self error: 'vertices was nil, should be an array of points'].
	vertices size \\ 4 = 0
		ifFalse: [self error: 'a cubic bezier curve must have exactly 4 points (two endpoints and two control points'].

	"The drawing space gets messy when trying to fill a figure that isn't closed, so if the BSpline isn't closed, just draw with fill color transparent"
	(self isClosed) ifFalse: [color := Color transparent].
	self drawBezier3Shape: aCanvas.
	(self isClosed) ifFalse: [color := c].
! !


!BSplineMorph methodsFor: 'geometry' stamp: 'TJ 3/29/2006 12:05'!
isClosed
	"figure out if the first and last vertices are the same.  Should probably check every time endpoints are moved and set the closed instance variable accordingly.  Also, no check is made to make sure that 4th and 5th points are the same, and so on.  See PolygonMorph::isClosed and PolygonMorph::makeClosed"
	^ ((vertices at: 1) = (vertices at: vertices size)).
! !


!BSplineMorph methodsFor: 'editing' stamp: 'TJ 3/29/2006 11:19'!
addHandles
	"endpoints are yellow circles, control points are red diamonds, knots are green circles.  Should eventually make endpoints into a single knot if BSpline is closed"
	| handle diamond |
	closed := false.
	(self isClosed)
	ifTrue: [closed := true].
	self removeHandles.
	handles := OrderedCollection new.
	diamond := Array with: 0@-4 with: 4@3 with: 1@9 with: -3@3.
	vertices withIndexDo:
		[:vertPt :vertIndex |
		(vertIndex \\ 4 = 0 or: [vertIndex \\ 4 = 1])
		ifTrue:
		[handle := EllipseMorph newBounds: (Rectangle center: vertPt extent: 8@8)
				color: Color yellow.].
		(vertIndex \\ 4 = 2 or: [vertIndex \\ 4 = 3])
		ifTrue:
		[handle := PolygonMorph
				vertices: (diamond collect: [:p | p + (vertPt + (vertices atWrap: vertIndex+1) // 2)])
				color: Color red borderWidth: 1 borderColor: Color black.].
		handle on: #mouseMove send: #dragVertex:event:fromHandle:
				to: self withValue: vertIndex.
		handle on: #mouseUp send: #dropVertex:event:fromHandle:
				to: self withValue: vertIndex.
		self addMorph: handle. 
		handles addLast: handle.].
	self changed! !

!BSplineMorph methodsFor: 'editing' stamp: 'TJ 3/28/2006 17:14'!
dragVertex: ix event: evt fromHandle: handle
	| p |
	p := self isCurve
		ifTrue: [evt cursorPoint]
		ifFalse: [self griddedPoint: evt cursorPoint].
	handle position: p - (handle extent//2).
	self verticesAt: ix put: p.
	((self isClosed or: [(ix = 1 or: [ix = vertices size]) not]) and: [ix \\ 4 < 2])
	"(((ix = 1 or: [ix = vertices size]) not) and: [ix \\ 4 < 2])"
	ifTrue:
	[(ix \\ 4 = 0) 
		ifTrue: [self verticesAtWrap: (ix + 1) put: p].
	 (ix \\ 4 = 1)
		ifTrue: [self verticesAtWrap: (ix - 1) put: p].].
	
! !

!BSplineMorph methodsFor: 'editing' stamp: 'TJ 3/28/2006 15:01'!
updateHandles
	| oldVert |
	vertices
				withIndexDo: [:vertPt :vertIndex | 

					"Transcript show: 'Control Point '.
					Transcript show: vertIndex.
					Transcript show: ' of '.
					Transcript show: vertices.
					Transcript cr."
					oldVert := handles at: vertIndex.
					oldVert position: vertPt - (oldVert extent // 2).]! !

!BSplineMorph methodsFor: 'editing' stamp: 'TJ 3/28/2006 16:06'!
verticesAtWrap: ix put: newPoint
	vertices atWrap: ix put: newPoint.
	self computeBounds.! !


RectangleMorph subclass: #FractionCircleFrameMorph
	instanceVariableNames: 'circle rotateToFitP'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'CircularReasoning'!

!FractionCircleFrameMorph methodsFor: 'initialization' stamp: 'TJ 8/2/2006 16:45'!
initialize
	super initialize.
	self extent: 140@140.
	super color: (Color green).
	self enableDragNDrop.! !


!FractionCircleFrameMorph methodsFor: 'geometry' stamp: 'TJ 7/29/2006 12:15'!
circleDiameter
	^ self width min: self height * 10 / 14.! !

!FractionCircleFrameMorph methodsFor: 'geometry' stamp: 'TJ 8/2/2006 16:29'!
circleExtent
	^ (self circleDiameter @ self circleDiameter)! !

!FractionCircleFrameMorph methodsFor: 'geometry' stamp: 'TJ 8/2/2006 16:30'!
extent: newExtent
	| twiceApothem totalAngle |
	"for resizing with halo.  Optionally fits sectors to fraction circle when they are dropped"
	totalAngle := 0.
	twiceApothem := newExtent x min: newExtent y.
	super extent: twiceApothem @ twiceApothem.
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [
			self rotateToFitP ifTrue: [f heading: totalAngle.].
			f extent: self circleExtent. 
			f center: self center.
			totalAngle := totalAngle + f centralAngle
			]
	].
	self changed.
! !


!FractionCircleFrameMorph methodsFor: 'drawing' stamp: 'TJ 8/2/2006 16:30'!
drawOn: aCanvas 
	| newBounds |

	newBounds := (Rectangle center: self center extent: (self circleExtent)).
	super drawOn: aCanvas.
	aCanvas fillOval: newBounds fillStyle: Color white borderWidth: borderWidth borderColor: borderColor.
! !


!FractionCircleFrameMorph methodsFor: 'menu' stamp: 'TJ 8/2/2006 16:35'!
addCustomMenuItems: aMenu hand: aHandMorph
	aMenu add: 'plain' translated action: #bePlain.
	aMenu add: 'rotate fractures to fit' translated action: #beRotateToFit.

! !


!FractionCircleFrameMorph methodsFor: 'layout' stamp: 'TJ 8/2/2006 16:37'!
acceptDroppingMorph: aMorph event: anEvent 
	self addMorphCentered: aMorph.
	self extent: self extent.
! !

!FractionCircleFrameMorph methodsFor: 'layout' stamp: 'TJ 8/2/2006 16:33'!
bePlain
	self rotateToFitP: false.! !

!FractionCircleFrameMorph methodsFor: 'layout' stamp: 'TJ 8/2/2006 16:33'!
beRotateToFit
	self rotateToFitP: true.! !


!FractionCircleFrameMorph methodsFor: 'accessing' stamp: 'TJ 8/2/2006 16:48'!
color
	self rotateToFitP
	ifTrue: [^ Color gray].
	^ Color green.! !

!FractionCircleFrameMorph methodsFor: 'accessing' stamp: 'TJ 8/2/2006 16:49'!
color: aColor
	"Color is used to convey state of inset, so it shouldn't be changed by user"
! !

!FractionCircleFrameMorph methodsFor: 'accessing' stamp: 'TJ 8/2/2006 16:15'!
rotateToFitP
	rotateToFitP ifNil: [^ false].
	^rotateToFitP.! !

!FractionCircleFrameMorph methodsFor: 'accessing' stamp: 'TJ 8/2/2006 16:58'!
rotateToFitP: boolean
	rotateToFitP := boolean.
	boolean ifTrue: [
		super color: (Color gray).
		self extent: self extent.                  
	]
	ifFalse: [
		super color: (Color green).
	].
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

FractionCircleFrameMorph class
	instanceVariableNames: ''!

!FractionCircleFrameMorph class methodsFor: 'parts bin' stamp: 'TJ 8/30/2006 17:53'!
descriptionForPartsBin
	^ self partName:	'Fraction Circle Frame'
		categories:		#('Fractures')
		documentation:	'A frame for fractures.  Drag and drop fractures into it, and they will be automatically centered.'! !


!FractionCircleFrameMorph class methodsFor: 'scripting' stamp: 'TJ 8/30/2006 17:53'!
additionsToViewerCategories
^ #(
#(#'fraction circle frame'
#(
#(#slot #rotateToFit 'When fractures are dropped on the inset, does the inset rotate them to fit?' #Boolean #readWrite #Player #getRotateToFitP #Player #setRotateToFitP:) 
)
)
)! !


BSplineMorph subclass: #SliceMorph
	instanceVariableNames: 'radius initialAngle rotationPoint margin numerator denominator alreadyComputing sF'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'CircularReasoning'!

!SliceMorph methodsFor: 'drawing' stamp: 'TJ 5/5/2006 15:33'!
drawOn: aCanvas

	super drawOn: aCanvas. ! !


!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
centerOffset
	^ (self radius + self margin)@(self radius + self margin).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 7/3/2006 12:29'!
halfCentralAngleInRadians
	"angle used to calculate end points and control points"
	^ self halfCentralAngleInRadians: self centralAngle.
! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 7/3/2006 12:30'!
halfCentralAngleInRadians: angle
	"angle used to calculate end points and control points"

"	^ ((self heading + angle) / 2) degreesToRadians."
	^ ((angle) / 2) degreesToRadians.
! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
p0
	^ self p0: (self centralAngle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
p0: angle
	^ Point x: (self x0: angle) y: (self y0: angle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
p1
	^ self p1: (self centralAngle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
p1: angle
	^ Point x: (self x1: angle) y: (self y1: angle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
p2
	^ self p2: (self centralAngle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
p2: angle
	^ Point x: (self x2: angle) y: (self y2: angle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
p3
	^ self p3: (self centralAngle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
p3: angle
	^ Point x: (self x3: angle) y: (self y3: angle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 7/21/2006 11:35'!
rawVertices
	^ Array with: self p0 with: self p1 with: self p2 with: self p3.
! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 7/31/2006 14:49'!
startDelta
	self centralAngle > 0
	ifTrue: [^self startDelta: self centralAngle.]
	ifFalse: [^self startNegativeDelta: self centralAngle].
! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 7/31/2006 16:58'!
startDelta: angle
	"angle used to calculate end points and control points"
	| acuteOrNinety |
	acuteOrNinety := angle \\ 90.
	(acuteOrNinety = 0) ifTrue: [acuteOrNinety := 90].
	
	^ ((90 - (acuteOrNinety / 2)) - self heading) degreesToRadians.
! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 8/1/2006 14:48'!
startNegativeDelta: angle
	"angle used to calculate end points and control points"
	| acuteOrNinety |
	acuteOrNinety := angle abs \\ 90.
	(acuteOrNinety = 0) ifTrue: [acuteOrNinety := 90].
	
	^ (((90 - (acuteOrNinety / 2)) - self heading) + (angle abs)) degreesToRadians.

! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
x0
	^ self x0: (self centralAngle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
x0: angle
	"return x of first endpoint"
	^ self radius * ((self halfCentralAngleInRadians: angle) cos).
! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
x1
	^ self x1: (self centralAngle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
x1: angle
	"return x of first control point"
	^ self radius * (4 - ((self halfCentralAngleInRadians: angle) cos)) / 3.
! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
x2
	^ self x2: (self centralAngle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
x2: angle
	"return x of second control point"
	^ self x1: angle.
! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
x3
	^ self x3: (self centralAngle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
x3: angle
	"return x of second endpoint"
	^ self x0: angle.
! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
y0
	^ self y0: (self centralAngle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
y0: angle
	"return y of first endpoint"
	^ self radius * ((self halfCentralAngleInRadians:angle) sin) negated.
! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
y1
	^ self y1: (self centralAngle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/20/2006 18:17'!
y1: angle
	"return y of first control point"
	(0 = (self halfCentralAngleInRadians: angle) sin) ifTrue: [^ 0].
	^ self radius * (1 - ((self halfCentralAngleInRadians: angle) cos)) * ((self halfCentralAngleInRadians: angle) cos - 3) / (3 * (self halfCentralAngleInRadians: angle) sin).
! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
y2
	^ self y2: (self centralAngle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
y2: angle
	"return y of second control point"
	^ (self y1: angle) negated.
! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
y3
	^ self y3: (self centralAngle).! !

!SliceMorph methodsFor: 'geometry' stamp: 'TJ 5/5/2006 12:12'!
y3: angle
	"return y of second endpoint"
	^ (self y0: angle) negated.
! !


!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/20/2006 14:10'!
centralAngle
	^ (self numerator * 360 / self denominator) "rounded".
"
	(centralAngle isNil)
	ifTrue: [^ self defaultCentralAngle]
	ifFalse: [^ centralAngle].
"! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 6/21/2006 09:44'!
centralAngleZeroToThreeSixty
	((self centralAngle = 0) or: [(self centralAngle \\ 360) > 0])
	ifTrue: [^ (self centralAngle) \\ 360]
	ifFalse: [^ 360].
! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/20/2006 14:09'!
centralAngle: t
	t ifNil: [^ self].
	"centralAngle := t."
	numerator := 360 * t / self denominator.
	self radius ifNotNil: [self computeBounds.  self computeVertices].! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/20/2006 14:16'!
denominator
	"^ 360."

	(denominator isNil)
	ifTrue: [^ self defaultDenominator]
	ifFalse: [^ denominator].
! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/20/2006 14:22'!
denominator: newDenominator
	newDenominator ifNil: [^ self].
	"Change the numerator to try to preserve the same fraction"
	numerator := (newDenominator * numerator / self denominator) rounded.
	denominator := newDenominator.
	self radius ifNotNil: [self computeBounds.  self computeVertices].! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 15:41'!
getArcVertices
	^ vertices.
! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 15:42'!
getChordVertices
	"Straight lines are made with line segments whose control points are equal to the neighboring knot points."
	| newVertices |

	(vertices = nil) ifTrue: [^ nil].

	newVertices := Array new.
	newVertices := newVertices copyWith: (vertices at: 1).
	newVertices := newVertices copyWith: (vertices at: 1).
	newVertices := newVertices copyWith: (vertices at: (vertices size)).
	newVertices := newVertices copyWith: (vertices at: (vertices size)).

	^ newVertices.
! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 15:42'!
getInitialSatelliteVertex
	(vertices = nil) ifTrue: [^ nil] ifFalse: [^ vertices at: 1].
! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 15:42'!
getInitialSideVertices
	"Straight lines are made with line segments whose control points are equal to the neighboring knot points."
	| newVertices |

	(vertices = nil) ifTrue: [^ nil].

	newVertices := Array new.
	newVertices := newVertices copyWith: (self getRotationCenter).
	newVertices := newVertices copyWith: (self getRotationCenter).
	newVertices := newVertices copyWith: (vertices at: 1).
	newVertices := newVertices copyWith: (vertices at: 1).

	^ newVertices.
! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/31/2006 10:25'!
getSectorVertices
	"Straight lines are made with line segments whose control points are equal to the neighboring knot points."
	| newVertices |

	(vertices = nil) ifTrue: [^ nil].

	newVertices := vertices.
	newVertices := newVertices copyWith: (vertices at: (vertices size)).
	newVertices := newVertices copyWith: (vertices at: (vertices size)).
	newVertices := newVertices copyWith: (self getRotationCenter).
	newVertices := newVertices copyWith: (self getRotationCenter).
	newVertices := newVertices copyWith: (self getRotationCenter).
	newVertices := newVertices copyWith: (self getRotationCenter).
	newVertices := newVertices copyWith: (vertices at: 1).
	newVertices := newVertices copyWith: (vertices at: 1).

	^ newVertices.
! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 15:43'!
getSegmentVertices
	"Straight lines are made with line segments whose control points are equal to the neighboring knot points."
	| newVertices |

	(vertices = nil) ifTrue: [^ nil].

	newVertices := vertices.
	newVertices := newVertices copyWith: (vertices at: (vertices size)).
	newVertices := newVertices copyWith: (vertices at: (vertices size)).
	newVertices := newVertices copyWith: (vertices at: 1).
	newVertices := newVertices copyWith: (vertices at: 1).

	^ newVertices.
! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 15:44'!
getTerminalSatelliteVertex
	(vertices = nil) ifTrue: [^ nil] ifFalse: [^ vertices at: (vertices size)].
! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 15:44'!
getTerminalSideVertices
	"Straight lines are made with line segments whose control points are equal to the neighboring knot points."
	| newVertices |

	(vertices = nil) ifTrue: [^ nil].

	newVertices := Array new.
	newVertices := newVertices copyWith: (self getRotationCenter).
	newVertices := newVertices copyWith: (self getRotationCenter).
	newVertices := newVertices copyWith: (vertices at: (vertices size)).
	newVertices := newVertices copyWith: (vertices at: (vertices size)).

	^ newVertices.
! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 12:12'!
initialAngle
	^ initialAngle.! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 12:12'!
initialAngle: angle
	initialAngle := angle.! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 12:12'!
margin
	(margin isNil)
	ifTrue: [^ self defaultMargin]
	ifFalse: [^ margin * self scaleFactor].! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 12:12'!
margin: m
	m ifNil: [^ self].
	margin := m.
! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/7/2006 16:25'!
numerator
	(numerator isNil)
	ifTrue: [^ self defaultNumerator]
	ifFalse: [^ numerator].! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 8/15/2006 17:27'!
numerator: n
	| c |
	c := self center.
	n ifNil: [^ self].
	numerator := n.
	self radius ifNotNil: [self computeBounds.  self computeVertices].
	c = self center
	ifFalse: [self position: self position + (c - self center)].
! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 12:12'!
radius
	(radius isNil)
	ifTrue: [^ self defaultRadius]
	ifFalse: [^ radius * self scaleFactor].! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 12:12'!
radius: r
	r ifNil: [^ self].
	radius := r.
	self centralAngle ifNotNil: [self computeBounds. self computeVertices].! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 12:12'!
rotationPoint
	^ rotationPoint.! !

!SliceMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 12:12'!
rotationPoint: point
	rotationPoint := point.! !


!SliceMorph methodsFor: 'initialization' stamp: 'TJ 7/13/2006 16:03'!
defaultCentralAngle 
	^ 60.! !

!SliceMorph methodsFor: 'initialization' stamp: 'TJ 5/7/2006 16:11'!
defaultDenominator
	^ 360.! !

!SliceMorph methodsFor: 'initialization' stamp: 'TJ 5/5/2006 12:12'!
defaultMargin
	^ 6.
! !

!SliceMorph methodsFor: 'initialization' stamp: 'TJ 5/7/2006 16:30'!
defaultNumerator
	^ (60 * self denominator / 360) rounded.! !

!SliceMorph methodsFor: 'initialization' stamp: 'TJ 5/5/2006 12:12'!
defaultRadius
	^ 20.! !

!SliceMorph methodsFor: 'initialization' stamp: 'TJ 5/20/2006 17:03'!
initializeWith: scMorph

	"Inherited from Morph"
	bounds := scMorph bounds.
	color := scMorph color.
	extension := scMorph extension.

	"Inherited from BorderedMorph."
	borderWidth := scMorph borderWidth.
	borderColor := scMorph borderColor.

	"Inherited from PolygonMorph.  Instance variables from PolygonMorph that are not set here are:
		arrows, arrowForms, curveState, borderDashSpec, and handles"
	vertices := scMorph vertices.
	closed := scMorph isClosed.
	filledForm := scMorph filledForm.
	smoothCurve := scMorph isCurve.
	borderForm := scMorph borderForm.

	"Instance variables of this class."
	radius := scMorph radius.
	numerator := scMorph numerator.
	denominator := scMorph denominator.
	initialAngle := scMorph initialAngle.
	rotationPoint := scMorph rotationPoint.
	margin := scMorph margin.
	
	! !

!SliceMorph methodsFor: 'initialization' stamp: 'TJ 5/20/2006 17:04'!
initializeWith: r and: c
	radius := r.
	numerator := c.
	denominator := self defaultDenominator.
	self computeBounds.
	self computeVertices.! !

!SliceMorph methodsFor: 'initialization' stamp: 'TJ 7/15/2006 16:13'!
initializeWith: r and: n and: d.
	radius := r.
	numerator := n.
	denominator := d.
	self computeBounds.
	self computeVertices.! !


!SliceMorph methodsFor: 'event handling' stamp: 'TJ 5/5/2006 12:12'!
handlesMouseDown: evt
	"Prevents handles from appearing on Shift-Click."
	^ false.! !


!SliceMorph methodsFor: 'testing' stamp: 'TJ 5/5/2006 12:12'!
needsTesting
	"The following methods haven't been tested:

		centralAngle:
		radius:"
! !

!SliceMorph methodsFor: 'testing' stamp: 'TJ 5/24/2006 15:27'!
verticesAsIntegerPoints

	| newVertices |

	(vertices) ifNil: [^ nil.].
	newVertices := vertices collect:
		[:vertex | vertex asIntegerPoint ].

	^ newVertices.	 ! !

!SliceMorph methodsFor: 'testing' stamp: 'TJ 5/24/2006 15:42'!
verticesAsIntegerPoints: oldVertices

	| newVertices |

	(oldVertices) ifNil: [^ nil.].
	newVertices := oldVertices collect:
		[:vertex | vertex asIntegerPoint ].

	^ newVertices.	 ! !


!SliceMorph methodsFor: 'private' stamp: 'TJ 7/4/2006 15:12'!
addVertices: angle
	| verticesToChange verticesToAdd |
	verticesToChange := vertices.
	verticesToAdd := Array with: (self p0: angle) with: (self p1: angle) with: (self p2: angle) with: (self p3: angle).
	(verticesToChange) ifNil: [vertices := verticesToAdd. ^ self].

	verticesToChange := verticesToChange collect:
		[:vertex | vertex rotateBy: ((45 + (angle / 2)) degreesToRadians) negated about: 0@0 ].

	verticesToAdd reverse do: [:element | verticesToChange := verticesToChange copyWithFirst: element].

	vertices := verticesToChange.
! !

!SliceMorph methodsFor: 'private' stamp: 'TJ 8/14/2006 18:59'!
computeVertices

	| angle |

	angle := self centralAngle \\ 360.
	self centralAngle < 0
	ifTrue: [angle := 360 - angle].
	(angle = 0) ifTrue: [angle := 360. (self centralAngle = 0) ifTrue: ["handled in drawOn:"]].

	vertices := nil.
	[angle > 0] whileTrue: [
		(angle > 90) ifTrue: [self addVertices: 90] ifFalse: [self addVertices: angle].
		angle := angle - 90.].

	vertices ifNil: [vertices := self rawVertices.].

	self rotateBy: self startDelta about: 0@0.

	self translateBy: self getRotationCenter.
	
	self centralAngle < 0
	ifTrue: [vertices := vertices reversed.].
	self changed.
! !

!SliceMorph methodsFor: 'private' stamp: 'TJ 7/3/2006 12:19'!
computeVertices0

	| angle |
"Acts funny when either script is ticking (continually calling this method) and you try to change heading"

	(alreadyComputing = true) ifTrue: [^ self].
	alreadyComputing = true.

	"Transcript show: '[1] computeVertices:heading='. Transcript show: self heading;cr."

	"TODO: draw something reasonable for central angle values < 0 or > 360.."
	(self centralAngle < 0) ifTrue: [self error: 'central angle cannot be less than 0'].
	(self centralAngle > 360) ifTrue: [self error: 'central angle cannot be greater than 360'].

	"Transcript show: 'sectorColor='.  Transcript show: (self asFractureMorph) sectorColor;cr.
	Transcript show: 'heading='.  Transcript show: self heading;cr.
	Transcript show: 'forwardDiretion='.  Transcript show: self forwardDirection;cr.
	Transcript show: 'degreesOfFlex='.  Transcript show: self degreesOfFlex;cr.
	Transcript show: 'centralAngle='.  Transcript show: self centralAngle;cr.
	Transcript show: 'numerator='.  Transcript show: self numerator;cr.
	Transcript show: 'denominator='.  Transcript show: self denominator;cr.
	Transcript show: 'computeVertices:vertices='. Transcript show: self verticesAsIntegerPoints;cr.
	Transcript show: '===========================================================================================';cr."

	angle := self centralAngle \\ 360.
	(angle = 0) ifTrue: [angle := 360. (self centralAngle = 0) ifTrue: ["handled in drawOn:"]].
	vertices := nil.
	[angle > 0] whileTrue: [
		(angle > 90) ifTrue: [self addVertices: 90] ifFalse: [self addVertices: angle].
		angle := angle - 90.].

	"Transcript show: '[1] computeVertices:vertices='. Transcript show: self verticesAsIntegerPoints;cr."

	vertices ifNil: [vertices := self rawVertices.].

	"Transcript show: '[2] computeVertices:vertices='. Transcript show: self verticesAsIntegerPoints;cr."

	self rotateClockWiseBy: self startDelta about: 0@0.

	self translateBy: self getRotationCenter.

	"Transcript show: '[2] computeVertices:heading='. Transcript show: self heading;cr."

	"Transcript show: 'computeVertices:vertices='. Transcript show: self verticesAsIntegerPoints;cr.
	Transcript show: 'computeVertices:getSegmentVertices='. Transcript show: (self verticesAsIntegerPoints: self getSegmentVertices);cr."
	self changed.
	alreadyComputing = false.
! !

!SliceMorph methodsFor: 'private' stamp: 'TJ 7/3/2006 12:32'!
computeVertices1

	vertices := self rawVertices.
	self translateBy: self getRotationCenter.
! !

!SliceMorph methodsFor: 'private' stamp: 'TJ 5/20/2006 17:09'!
getRotationCenter
	"To calculate the rotation point for this arc, we need to find the perpendicular bisector that starts on the midpoint between p0 and p3 and extends for a length of radius * (halfCentralAngleInRadians cos).  Pick the direction that gives the point farther from p1"
	| vStart vLength vSlope deltaX deltaY v1End v2End  c v |
	"(rotationPoint) ifNotNil: [rotationPoint := bounds topLeft + self centerOffset. ^ rotationPoint]."
	(rotationPoint) ifNotNil: [rotationPoint := bounds center. ^ rotationPoint].

	v := self rawVertices.

	vStart := (((v at: 1) x + (v at: 4) x) / 2) @
		(((v at: 1) y + (v at: 4) y) / 2).

	vLength := (self radius) * self halfCentralAngleInRadians cos.

	((v at: 1) y = ((v at: 4) y))
	ifTrue: [deltaX := vLength. deltaY := 0]
	ifFalse: [
		"to be perpendicular to the line from p0 to p3, our delta vector needs a slope that is the negative inverse of the slope of the line from p0 to p3"
		vSlope := ((v at: 1) x - (v at: 4) x) / 
			((v at: 1) y - (v at: 4) y) negated.
	
		deltaX := vLength / ((1 + (vSlope raisedTo: 2)) sqrt).
	
		deltaY := vLength * vSlope / ((1 + (vSlope raisedTo: 2)) sqrt).
	].

	v1End := (vStart x + deltaX) @ (vStart y + deltaY).

	v2End := (vStart x - deltaX) @ (vStart y - deltaY).

	(((v at: 2) dist: v1End) > ((v at: 2) dist: v2End))
	ifTrue: [c := v1End] ifFalse: [c := v2End].

	rotationPoint := bounds origin - c.
	^ rotationPoint.


! !


!SliceMorph methodsFor: 'geometry eToy' stamp: 'TJ 8/4/2006 17:31'!
scaleFactor
	sF ifNil: [^ super scaleFactor].
	^ sF.! !

!SliceMorph methodsFor: 'geometry eToy' stamp: 'TJ 8/14/2006 18:53'!
scale: scaleFactor 
	| c |
	c := self center.
	sF := scaleFactor.
	self computeVertices.
	self computeBounds.
	c = self center
	ifFalse: [self position: self position + (c - self center)].
! !


!SliceMorph methodsFor: 'converting' stamp: 'TJ 6/30/2006 11:08'!
asFractureMorph
	^(FractureMorph from: self).! !

!SliceMorph methodsFor: 'converting' stamp: 'TJ 8/14/2006 18:55'!
computeBounds
	"radius should equal the distance from getRotationCenter to the first vertex.
	Need to synchronize update of bounds with radius, theta, vertices, rotation, scaling."
	| side |
	radius ifNil: [^ self].
	numerator ifNil: [^ self].

	side := 2*(self radius+self margin).
	bounds := Rectangle center: self getRotationCenter extent: side@side.
	self rotationCenter: 0.5@0.5.
	self layoutChanged.	
	self changed.
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

SliceMorph class
	instanceVariableNames: ''!

!SliceMorph class methodsFor: 'instance creation' stamp: 'TJ 5/5/2006 12:12'!
from: scMorph
	| newMorph |
	newMorph := SectionComponentMorph new.
	newMorph initializeWith: scMorph.
	^ newMorph.
! !

!SliceMorph class methodsFor: 'instance creation' stamp: 'TJ 7/15/2006 16:14'!
radius: r centralAngle: c
	
	| arc |
	arc := self new.
	arc initializeWith: r and: c and: 360.
	^ arc.! !

!SliceMorph class methodsFor: 'instance creation' stamp: 'TJ 5/5/2006 12:12'!
radius: r centralAngle: t color: c width: w
	
	| arc |
	arc := self radius: r centralAngle: t.
	arc color: Color transparent.
	arc borderWidth: w.
	arc borderColor: c.
	^ arc.! !

!SliceMorph class methodsFor: 'instance creation' stamp: 'TJ 7/15/2006 16:14'!
radius: r numerator: n denominator: d
	
	| arc |
	arc := self new.
	arc initializeWith: r and: n and: d.
	^ arc.! !


SliceMorph subclass: #FractureMorph
	instanceVariableNames: 'arcColor centerColor chordColor initialSatelliteColor initialSideColor sectorColor segmentColor terminalSatelliteColor terminalSideColor initialArrowColor terminalArrowColor centerPiece initialSatellitePiece terminalSatellitePiece centerRadius initialSatelliteRadius terminalSatelliteRadius turnsAndDrops turnsWithSweep slide dropColor dropBorderWidth dropBorderColor dropChangesShade dropColorWheelSize dropColorWheel dropColorWheelIndex degreesToTurn'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'CircularReasoning'!
!FractureMorph commentStamp: '<historical>' prior: 0!
You can use this morph to represent angles in a variety of ways.!


!FractureMorph methodsFor: 'drawing' stamp: 'TJ 5/31/2006 11:33'!
addCenter
	| newBounds |

	newBounds := (Rectangle center: self center extent: (self centerRadius)@(self centerRadius)).
	(centerPiece = nil) ifTrue: [
		centerPiece := EllipseMorph newBounds: newBounds color: self centerColor.
		centerPiece borderWidth: 0.
		self addMorph: centerPiece.
	]
	ifFalse: [
		centerPiece bounds: newBounds.
		centerPiece color: self centerColor.
	].
! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 5/31/2006 11:34'!
addInitialSatellite
	| newBounds |

	newBounds := (Rectangle center: self getInitialSatelliteVertex 
			extent: (self initialSatelliteRadius)@(self initialSatelliteRadius)).
	(initialSatellitePiece = nil) ifTrue: [
		initialSatellitePiece := EllipseMorph newBounds: newBounds
			color: self initialSatelliteColor.
		initialSatellitePiece borderWidth: 0.
		self addMorph: initialSatellitePiece.
	]
	ifFalse: [
		initialSatellitePiece color: self initialSatelliteColor.
		initialSatellitePiece bounds: newBounds
	].
! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 5/31/2006 11:33'!
addTerminalSatellite
	| newBounds |

	newBounds := (Rectangle center: self getTerminalSatelliteVertex 
			extent: (self terminalSatelliteRadius)@(self terminalSatelliteRadius)).
	(terminalSatellitePiece = nil) ifTrue: [
		terminalSatellitePiece := EllipseMorph newBounds: newBounds
			color: self terminalSatelliteColor.
		terminalSatellitePiece borderWidth: 0.
		self addMorph: terminalSatellitePiece.
	]
	ifFalse: [
		terminalSatellitePiece bounds: newBounds.
		terminalSatellitePiece color: self terminalSatelliteColor.
	].
! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 7/31/2006 20:36'!
coneContainsPoint: aPoint
	"Returns true if aPoint lies on the portion of the plane determined by getRotatonCenter and centralAngle"

	| bearingPoint bearingStart bearingEnd |

	(vertices = nil) ifTrue: [^false].

	bearingPoint := (self getRotationCenter) bearingToPoint: aPoint.
	self centralAngle < 0
	ifTrue: [
		bearingStart := (self getRotationCenter) bearingToPoint: (vertices at: (vertices size)).
		bearingEnd := (self getRotationCenter) bearingToPoint: (vertices at: 1).
	]
	ifFalse: [
		bearingStart := (self getRotationCenter) bearingToPoint: (vertices at: 1).
		bearingEnd := (self getRotationCenter) bearingToPoint: (vertices at: (vertices size)).
	].

	(bearingStart < bearingEnd)
	ifTrue: [^(bearingStart <= bearingPoint) and: [bearingPoint <= bearingEnd]].

	^((bearingStart <= bearingPoint) and: [bearingPoint <= 360])
			or: [(0 <= bearingPoint) and: [bearingPoint <= bearingEnd]].
! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 6/29/2006 15:49'!
drawArc: aCanvas
	self drawBezier3Shape: aCanvas vertices: self getArcVertices color: (Color transparent) borderWidth: self borderWidth borderColor: self arcColor.



! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 7/20/2006 12:23'!
drawArrowsOn: aCanvas
	| originalBorderColor |
	originalBorderColor := borderColor.
	self borderColor: self initialArrowColor.
	self drawArrowOn: aCanvas at: self getInitialSatelliteVertex from: self center.
	self borderColor: self terminalArrowColor.
	self drawArrowOn: aCanvas at: self getTerminalSatelliteVertex from: self center.
	borderColor := originalBorderColor.
! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 7/23/2006 18:02'!
drawBezier3Shape: aCanvas vertices: shapeVertices color: shapeColor borderWidth: shapeBorderWidth borderColor: shapeBorderColor
	| bCanvas |
	shapeVertices ifNil: [^self].
	(0 = self centralAngle) ifTrue: [^ self].
	(0 = self radius) ifTrue: [^ self].
	bCanvas := aCanvas asBalloonCanvas aaLevel: 4.
	bCanvas drawBezier3Shape: shapeVertices
                                color: shapeColor
                                borderWidth: shapeBorderWidth
                                borderColor: shapeBorderColor.
! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 5/31/2006 13:56'!
drawChord: aCanvas
	self drawBezier3Shape: aCanvas vertices: self getChordVertices color: (Color transparent) borderWidth: self borderWidth borderColor: self chordColor.
! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 8/23/2006 19:34'!
drawInitialSide: aCanvas
	aCanvas drawPolygon: self getInitialSideVertices color: (Color transparent) asColor borderWidth: self borderWidth borderColor: self initialSideColor.
! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 7/20/2006 05:49'!
drawOn: aCanvas 

	self prepShape.
	self drawSector: aCanvas.
	self drawSegment: aCanvas.
	self drawArc: aCanvas.
	self drawChord: aCanvas.
	self drawInitialSide: aCanvas.
	self drawTerminalSide: aCanvas.
	self addCenter.
	self addInitialSatellite.
	self addTerminalSatellite.
	self drawArrowsOn: aCanvas.
	self changed.
! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 7/31/2006 17:14'!
drawSector: aCanvas
	(self sectorColor = Color transparent) ifTrue: [^ self].
	(self centralAngle < 0)
	ifTrue: [self drawBezier3Shape: aCanvas vertices: self getSectorVertices color: self sectorColor negated borderWidth: self borderWidth borderColor: self borderColor.]
	ifFalse: [self drawBezier3Shape: aCanvas vertices: self getSectorVertices color: self sectorColor borderWidth: self borderWidth borderColor: self borderColor.].
! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 7/21/2006 06:13'!
drawSegment: aCanvas
	(self segmentColor = Color transparent) ifTrue: [^ self].
	self drawBezier3Shape: aCanvas vertices: self getSegmentVertices color: self segmentColor borderWidth: self borderWidth borderColor: self borderColor.
! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 8/23/2006 19:34'!
drawTerminalSide: aCanvas
	aCanvas drawPolygon: self getTerminalSideVertices color: (Color transparent) asColor borderWidth: self borderWidth borderColor: self terminalSideColor.

! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 5/31/2006 13:55'!
prepShape
	(vertices = nil) ifTrue: [^ self].
	(radius = nil) ifTrue: [
		radius := self defaultRadius.
		self computeBounds. self computeVertices.
	].
! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 5/4/2006 12:04'!
removeCenter
	centerPiece ifNotNil: [centerPiece delete.].
	centerPiece := nil.
! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 5/4/2006 12:06'!
removeInitialSatellite
	initialSatellitePiece ifNotNil: [initialSatellitePiece delete.].
	initialSatellitePiece := nil.
! !

!FractureMorph methodsFor: 'drawing' stamp: 'TJ 5/4/2006 14:20'!
removeTerminalSatellite
	terminalSatellitePiece ifNotNil: [terminalSatellitePiece delete.].
	terminalSatellitePiece := nil.
! !


!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/4/2006 11:21'!
arcColor
	(arcColor = nil) ifTrue: [^ Color transparent] ifFalse: [^arcColor].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/7/2006 15:23'!
arcColor: c
	arcColor := c..
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/4/2006 11:24'!
centerColor
	(centerColor = nil) ifTrue: [^ Color transparent] ifFalse: [^centerColor].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/7/2006 15:23'!
centerColor: c
	centerColor := c.
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 10:28'!
centerRadius
	(centerRadius = nil) ifTrue: [^ 8] ifFalse: [^centerRadius].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/7/2006 15:23'!
centerRadius: r
	centerRadius := r.
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 10:21'!
chordColor
	(chordColor = nil) ifTrue: [^ Color transparent] ifFalse: [^chordColor].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/7/2006 15:23'!
chordColor: c
	chordColor := c.
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/31/2006 20:31'!
degreesToTurn
	degreesToTurn = nil
	ifTrue: [^ 0].
	^degreesToTurn.! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/23/2006 17:27'!
degreesToTurn: d
	degreesToTurn := d.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/20/2006 14:42'!
dropBorderColor
	(dropBorderColor = nil) ifTrue: [^ Color transparent] ifFalse: [^dropBorderColor].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/20/2006 14:44'!
dropBorderColor: c
	dropBorderColor := c.
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/20/2006 14:43'!
dropBorderWidth
	(dropBorderWidth = nil) ifTrue: [^ 0] ifFalse: [^dropBorderWidth].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/20/2006 13:32'!
dropBorderWidth: aNumber
	dropBorderWidth := aNumber.! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/20/2006 21:03'!
dropChangesShade
	(dropChangesShade = nil) ifTrue: [^ 0] ifFalse: [^dropChangesShade].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/20/2006 21:03'!
dropChangesShade: aNumber
	dropChangesShade := aNumber.! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/20/2006 13:28'!
dropColor
	(dropColor = nil) ifTrue: [^ Color red] ifFalse: [^dropColor].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/21/2006 06:34'!
dropColorWheelSize
	dropColorWheelSize = nil
		ifTrue: [^ 1].
	dropColorWheelSize < 1
		ifTrue: [dropColorWheelSize := 1].
	^ dropColorWheelSize.! !

!FractureMorph methodsFor: 'accessing'!
dropColorWheelSize: aNumber 
	dropColorWheelSize := aNumber.
	aNumber > 1
		ifTrue: [dropColorWheel := Color wheel: aNumber]
		ifFalse: [dropColorWheel := nil]! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/20/2006 13:29'!
dropColor: c
	dropColor := c.
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/20/2006 05:40'!
initialArrowColor
	(initialArrowColor = nil) ifTrue: [^ Color transparent] ifFalse: [^initialArrowColor].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/20/2006 05:41'!
initialArrowColor: c
	initialArrowColor := c.
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/4/2006 11:27'!
initialSatelliteColor
	(initialSatelliteColor = nil) ifTrue: [^ Color transparent] ifFalse: [^initialSatelliteColor].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/7/2006 15:23'!
initialSatelliteColor: c
	initialSatelliteColor := c.
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 10:30'!
initialSatelliteRadius
	(initialSatelliteRadius = nil) ifTrue: [^ 8] ifFalse: [^initialSatelliteRadius].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/7/2006 15:23'!
initialSatelliteRadius: r
	initialSatelliteRadius := r.
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/4/2006 11:23'!
initialSideColor
	(initialSideColor = nil) ifTrue: [^ Color transparent] ifFalse: [^initialSideColor].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/7/2006 15:23'!
initialSideColor: c
	initialSideColor := c.
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 6/27/2006 14:41'!
isDropper
	turnsAndDrops ifNil: [^ false].
	^ turnsAndDrops.! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 6/27/2006 14:45'!
isDropper: dropsOrNot
	turnsAndDrops := dropsOrNot.! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 6/27/2006 14:42'!
isSweeper
	turnsWithSweep ifNil: [^ false].
	^ turnsWithSweep.! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 6/27/2006 14:45'!
isSweeper: sweepssOrNot
	turnsWithSweep := sweepssOrNot.! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/4/2006 11:22'!
sectorColor
	(sectorColor = nil) ifTrue: [^ Color transparent] ifFalse: [^sectorColor].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/7/2006 15:23'!
sectorColor: c
	sectorColor := c.
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/4/2006 11:22'!
segmentColor
	(segmentColor = nil) ifTrue: [^ Color transparent] ifFalse: [^segmentColor].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/7/2006 15:24'!
segmentColor: c
	segmentColor := c.
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/20/2006 05:41'!
terminalArrowColor
	(terminalArrowColor = nil) ifTrue: [^ Color transparent] ifFalse: [^terminalArrowColor].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 7/20/2006 05:41'!
terminalArrowColor: c
	terminalArrowColor := c.
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/4/2006 11:28'!
terminalSatelliteColor
	(terminalSatelliteColor = nil) ifTrue: [^ Color transparent] ifFalse: [^terminalSatelliteColor].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/7/2006 15:24'!
terminalSatelliteColor: c
	terminalSatelliteColor := c.
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/5/2006 10:30'!
terminalSatelliteRadius
	(terminalSatelliteRadius = nil) ifTrue: [^ 8] ifFalse: [^terminalSatelliteRadius].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/7/2006 15:24'!
terminalSatelliteRadius: r
	terminalSatelliteRadius := r.
	self changed.
! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/4/2006 11:23'!
terminalSideColor
	(terminalSideColor = nil) ifTrue: [^ Color transparent] ifFalse: [^terminalSideColor].! !

!FractureMorph methodsFor: 'accessing' stamp: 'TJ 5/7/2006 15:24'!
terminalSideColor: c
	terminalSideColor := c.
	self changed.
! !


!FractureMorph methodsFor: 'initialization' stamp: 'TJ 7/21/2006 06:13'!
initialize
	super initialize.
	self initializeWith: 50 and: 60.
	sectorColor := Color red.
	dropColorWheelIndex := 0! !


!FractureMorph methodsFor: 'geometry testing' stamp: 'TJ 5/5/2006 12:07'!
arcContainsPoint: aPoint

	(self arcColor isTransparent) ifTrue: [^false].
	^ (self coneContainsPoint: aPoint) and:
	[((aPoint dist: (self getRotationCenter)) - radius) abs < self borderWidth].
! !

!FractureMorph methodsFor: 'geometry testing' stamp: 'TJ 5/6/2006 11:24'!
centerContainsPoint: aPoint
	(self centerColor isTransparent) ifTrue: [^false].
	^ (aPoint dist: (self getRotationCenter)) < (self centerRadius).
! !

!FractureMorph methodsFor: 'geometry testing' stamp: 'TJ 5/5/2006 17:54'!
chordContainsPoint: aPoint
	(self chordColor isTransparent) ifTrue: [^false].
	^ (aPoint onLineFrom: (vertices at: 1) to: (vertices at: (vertices size)) within: self borderWidth).
! !

!FractureMorph methodsFor: 'geometry testing' stamp: 'TJ 7/5/2006 11:12'!
containsPoint: aPoint
	(self bounds containsPoint: aPoint) ifFalse: [^ false].
	(self sectorContainsPoint: aPoint) ifTrue: [^ true].
	(self segmentContainsPoint: aPoint) ifTrue: [^ true].
	(self arcContainsPoint: aPoint) ifTrue: [^ true].
	(self centerContainsPoint: aPoint) ifTrue: [^ true].
	(self chordContainsPoint: aPoint) ifTrue: [^ true].
	(self initialSatelliteContainsPoint: aPoint) ifTrue: [^ true].
	(self initialSideContainsPoint: aPoint) ifTrue: [^ true].
	(self terminalSatelliteContainsPoint: aPoint) ifTrue: [^ true].
	(self terminalSideContainsPoint: aPoint) ifTrue: [^ true].
	^ false.
! !

!FractureMorph methodsFor: 'geometry testing' stamp: 'TJ 5/6/2006 11:28'!
initialSatelliteContainsPoint: aPoint
	(self initialSatelliteColor isTransparent) ifTrue: [^false].
	^ (aPoint dist: (self getInitialSatelliteVertex)) < (self initialSatelliteRadius).
! !

!FractureMorph methodsFor: 'geometry testing' stamp: 'TJ 5/5/2006 17:55'!
initialSideContainsPoint: aPoint
	(self initialSideColor isTransparent) ifTrue: [^false].
	^ (aPoint onLineFrom: (self getRotationCenter) to: (vertices at: 1) within: self borderWidth).
! !

!FractureMorph methodsFor: 'geometry testing' stamp: 'TJ 5/4/2006 17:55'!
quadrant: aPoint
	"return which quadrant this point is in"

	(self getRotationCenter x < aPoint x)
	ifTrue: [(self getRotationCenter y > aPoint y) ifTrue: [^1] ifFalse: [^2]]
	ifFalse: [(self getRotationCenter y < aPoint y) ifTrue: [^3] ifFalse: [^4]].! !

!FractureMorph methodsFor: 'geometry testing' stamp: 'TJ 7/5/2006 11:13'!
sectorAnyColorContainsPoint: aPoint
	^ (self coneContainsPoint: aPoint) and: [((aPoint dist: (self getRotationCenter)) < (radius*self scaleFactor))].
! !

!FractureMorph methodsFor: 'geometry testing' stamp: 'TJ 7/5/2006 11:14'!
sectorContainsPoint: aPoint

	(self sectorColor isTransparent) ifTrue: [^ false].
	^ self sectorAnyColorContainsPoint: aPoint.
! !

!FractureMorph methodsFor: 'geometry testing' stamp: 'TJ 5/6/2006 11:46'!
segmentContainsPoint: aPoint

	(self segmentColor isTransparent) ifTrue: [^ false].

	(self centralAngle < 180) ifTrue: [
		^ (self sectorAnyColorContainsPoint: aPoint) and: [
			(aPoint insideTriangle: 
			(self getRotationCenter) with: (vertices at: 1) with: (vertices at: (vertices size))) not]
	].

	(self centralAngle > 180) ifTrue: [
		^ (self sectorAnyColorContainsPoint: aPoint) or: [
			aPoint insideTriangle: 
			(self getRotationCenter) with: (vertices at: 1) with: (vertices at: (vertices size))]
	].

	(self centralAngle = 180) ifTrue: [^ self sectorContainsPoint: aPoint].
! !

!FractureMorph methodsFor: 'geometry testing' stamp: 'TJ 5/6/2006 11:29'!
terminalSatelliteContainsPoint: aPoint
	(self terminalSatelliteColor isTransparent) ifTrue: [^false].
	^ (aPoint dist: (self getTerminalSatelliteVertex)) < (self terminalSatelliteRadius).
! !

!FractureMorph methodsFor: 'geometry testing' stamp: 'TJ 5/5/2006 17:56'!
terminalSideContainsPoint: aPoint
	(self terminalSideColor isTransparent) ifTrue: [^false].
	^ (aPoint onLineFrom: (self getRotationCenter) to: (vertices at: (vertices size)) within: self borderWidth).
! !


!FractureMorph methodsFor: 'geometry eToy' stamp: 'TJ 8/25/2006 10:26'!
heading: t1 
	| t2 t3 t4 inc c |
	c := self center.

	((owner = nil) or: [(self degreesToTurn) = 0])
		ifTrue: [^ super heading: t1].

	(self degreesToTurn) > 0 ifTrue: [inc := 1] ifFalse: [inc := -1].
	self degreesToTurn: nil.
	t3 := self heading.
	t4 := 0.
	[(t3 \\ 360 - (t1 \\ 360)) abs < 1]
		whileFalse: [t3 := inc + t3.
			t4 := inc + t4].
	self dropColorWheelSize > 1
		ifTrue: [dropColorWheelIndex := dropColorWheelIndex + 1.
			self
				dropColor: (dropColorWheel atWrap: dropColorWheelIndex)].
	self dropChangesShade < -1
		ifTrue: [self dropColor: self dropColor twiceLighter].
	self dropChangesShade = -1
		ifTrue: [self dropColor: self dropColor lighter].
	self dropChangesShade = 1
		ifTrue: [self dropColor: self dropColor darker].
	self dropChangesShade > 1
		ifTrue: [self dropColor: self dropColor twiceDarker].
	t2 := FractureMorph
				radius: self radius
				centralAngle: 0
				color: self dropColor
				width: self dropBorderWidth.
	t2 borderColor: self dropBorderColor.
	self owner addMorphBack: t2.
	t2 x: self x.
	t2 y: self y.
	t2 forwardDirection: self forwardDirection \\ 360.
	self isSweeper
		ifTrue: [t2 sectorColor: self dropColor.
			[(self heading \\ 360 - (t1 \\ 360)) abs < 1]
				whileFalse: [(Delay forMilliseconds: 20) wait.
					super heading: inc + self heading.
					t2 centralAngle: inc + t2 centralAngle.
					self world displayWorldSafely]].
	self isDropper
		ifTrue: [t2 denominator: 360.
			t2 numerator: t4.
			t2 sectorColor: self dropColor.
			t2 changed]
		ifFalse: [self owner removeMorph: t2].
	super heading: t1.
	c = self center
	ifFalse: [self position: self position + (c - self center)].
! !


!FractureMorph methodsFor: 'converting' stamp: 'TJ 6/30/2006 11:05'!
asFractureMorph
	^ self! !


!FractureMorph methodsFor: 'geometry' stamp: 'TJ 7/29/2006 10:54'!
beAngle
	self clear.
	self initialSideColor: Color black.
	self terminalSideColor: Color black.
	self initialArrowColor: Color black.
	self terminalArrowColor: Color black.
! !

!FractureMorph methodsFor: 'geometry' stamp: 'TJ 7/29/2006 10:55'!
beArc
	self clear.
	self arcColor: Color black.
! !

!FractureMorph methodsFor: 'geometry' stamp: 'TJ 7/29/2006 10:55'!
beSatellites
	self clear.
	self initialSatelliteColor: Color orange.
	self terminalSatelliteColor: Color blue.
	self centerColor: Color black.
! !

!FractureMorph methodsFor: 'geometry' stamp: 'TJ 7/29/2006 10:55'!
beSector
	self clear.
	self sectorColor: Color red.
! !

!FractureMorph methodsFor: 'geometry' stamp: 'TJ 7/29/2006 10:56'!
beSegment
	self clear.
	self segmentColor: Color green.
! !

!FractureMorph methodsFor: 'geometry' stamp: 'TJ 7/29/2006 10:57'!
beTail
	self clear.
	self initialSideColor: Color black.
	self centerColor: Color black.
! !

!FractureMorph methodsFor: 'geometry' stamp: 'TJ 8/16/2006 10:18'!
beVector
	self clear.
	self initialSideColor: Color black.
	self initialArrowColor: Color black.
	self centerColor: Color black.
! !

!FractureMorph methodsFor: 'geometry' stamp: 'TJ 7/29/2006 10:54'!
clear
	self arcColor: Color transparent.
	self centerColor: Color transparent.
	self chordColor: Color transparent.
	self initialArrowColor: Color transparent.
	self initialSatelliteColor: Color transparent.
	self initialSideColor: Color transparent.
	self sectorColor: Color transparent.
	self segmentColor: Color transparent.
	self terminalArrowColor: Color transparent.
	self terminalSatelliteColor: Color transparent.
	self terminalSideColor: Color transparent.
! !

!FractureMorph methodsFor: 'geometry' stamp: 'TJ 8/23/2006 19:17'!
clearOthers
	owner removeAllMorphsIn: 
		(owner submorphsSatisfying: [:a | (a isKindOf: FractureMorph) 
		and: [(a = self) not]]).! !

!FractureMorph methodsFor: 'geometry' stamp: 'TJ 8/3/2006 20:37'!
extent: newExtent

	| oldWidth newWidth |
	oldWidth := self width.
	newWidth := (newExtent x) min: (newExtent y).
	self radius: self radius * newWidth / oldWidth.
	self layoutChanged.
	self changed.

! !

!FractureMorph methodsFor: 'geometry' stamp: 'TJ 7/16/2006 07:31'!
slide
	slide ifNil: [^ 0].
	^ slide.! !

!FractureMorph methodsFor: 'geometry' stamp: 'TJ 7/16/2006 09:34'!
slideHeading
	^ (self heading + self centralAngle + ((180 - self centralAngle) / 2)) \\ 360.
! !

!FractureMorph methodsFor: 'geometry' stamp: 'TJ 8/14/2006 18:58'!
slide: newSlide
	| deltaSlide newX newY |
	deltaSlide := newSlide - self slide.
	newX := self center x + (deltaSlide * (self slideHeading degreeSin)).
	newY := self center y - (deltaSlide * (self slideHeading degreeCos)).
	self center: newX @ newY.
	slide := newSlide.
! !

!FractureMorph methodsFor: 'geometry' stamp: 'TJ 7/16/2006 10:17'!
slide: newSlide from: c
	| newX newY |
	newX := c x + (newSlide * (self slideHeading degreeSin)).
	newY := c y - (newSlide * (self slideHeading degreeCos)).
	self center: newX @ newY.
	slide := newSlide.
! !


!FractureMorph methodsFor: 'menu' stamp: 'TJ 7/20/2006 05:45'!
addCustomMenuItems: aMenu hand: aHandMorph
	aMenu add: 'sector' translated action: #beSector.
	aMenu add: 'segment' translated action: #beSegment.
	aMenu add: 'angle' translated action: #beAngle.
	aMenu add: 'arc' translated action: #beArc.
	aMenu add: 'satellites' translated action: #beSatellites.
	aMenu add: 'vector' translated action: #beVector.

! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

FractureMorph class
	instanceVariableNames: ''!

!FractureMorph class methodsFor: 'scripting' stamp: 'TJ 8/24/2006 16:46'!
additionsToViewerCategories
	"Answer a list of (<categoryName> <list of category specs>) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories."

^ #(

(#'drops & sweeps' (
	(slot dropBorderWidth 'The width of the drop''s border.' Number readWrite Player getDropBorderWidth Player setDropBorderWidth:)
	(slot dropColorWheelSize 'The size of the drop''s color wheel.' Number readWrite Player getDropColorWheelSize Player setDropColorWheelSize:)
	(slot dropChangesShade 'Change in drop shade after each turn. Use 0 for no change, 1 for darker, 2 for much darder, -1 for ligher, -2 for much lighter' Number readWrite Player getDropChangesShade Player setDropChangesShade: )
	(slot dropBorderColor 'Color of the drop border.' Color readWrite Player getDropBorderColor Player setDropBorderColor:)
	(slot dropColor 'Color of the drop.' Color readWrite Player getDropColor Player setDropColor:)
	(slot drops 'Does the fracture drop a sweep after it turns?' Boolean readWrite Player getDrops Player setDrops: )
	(slot sweeps 'Does the fracture sweep as it turns?' Boolean readWrite Player getSweeps Player setSweeps: )
))

(geometry (
	(slot numerator 'A number representing the numerator of the fraction made by the fracture.' Number readWrite Player getNumerator Player setNumerator:)
	(slot denominator 'A number representing the denominator of the fraction made by the fracture.' Number readWrite Player getDenominator Player setDenominator:)
))

(#'fracture color' (
	(slot arcColor 'Color of the arc.' Color readWrite Player getArcColor Player setArcColor:)
	(slot centerColor 'Color of the center point.' Color readWrite Player getCenterColor Player setCenterColor:)
	(slot chordColor 'Color of the chord.' Color readWrite Player getChordColor Player setChordColor:)
	(slot initialSatelliteColor 'Color of the initial satellite.' Color readWrite Player getInitialSatelliteColor Player setInitialSatelliteColor:)
	(slot initialSideColor 'Color of the initial side.' Color readWrite Player getInitialSideColor Player setInitialSideColor:)
	(slot initialArrowColor 'Color of the initial arrow.' Color readWrite Player getInitialArrowColor Player setInitialArrowColor:)
	(slot sectorColor 'Color of the sector.' Color readWrite Player getSectorColor Player setSectorColor:)
	(slot segmentColor 'Color of the segment.' Color readWrite Player getSegmentColor Player setSegmentColor:)
	(slot terminalArrowColor 'Color of the terminal arrow.' Color readWrite Player getTerminalArrowColor Player setTerminalArrowColor:)
	(slot terminalSatelliteColor 'Color of the terminal satellite.' Color readWrite Player getTerminalSatelliteColor Player setTerminalSatelliteColor:)
	(slot terminalSideColor 'Color of the terminal side.' Color readWrite Player getTerminalSideColor Player setTerminalSideColor:)
))
)

! !


!FractureMorph class methodsFor: 'parts bin' stamp: 'TJ 7/18/2006 07:49'!
descriptionForPartsBin
	^ self partName:	'Fracture'
		categories:		#('Graphics' 'Basic' 'Fractures')
		documentation:	'A morphic for representing angles.  Change fracture geometry numerator or denominator to change the angle.  When denominator is 360, angle is measured in degrees.  Change representations by changing items in fracture colors.'! !


FractureMorph subclass: #FractionCircleMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'CircularReasoning'!

!FractionCircleMorph methodsFor: 'accessing' stamp: 'TJ 7/16/2006 07:54'!
arcColor: c
	arcColor := c.
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f arcColor: c]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'accessing' stamp: 'TJ 7/15/2006 16:57'!
centerColor: c
	centerColor := c..
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f centerColor: c]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'accessing' stamp: 'TJ 7/15/2006 17:02'!
chordColor: c
	chordColor := c..
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f chordColor: c]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'accessing' stamp: 'TJ 7/16/2006 07:26'!
divisions
	^ self submorphCount.! !

!FractionCircleMorph methodsFor: 'accessing' stamp: 'TJ 7/23/2006 09:18'!
divisions: d
	| f |
	self removeAllMorphs.
	self centralAngle: 360 / d.
	1 to: d do: [:i | 
		f := FractureMorph radius: self radius numerator: 1 denominator: d.
		f heading: (i * 360 / d).
		f rotationDegrees: self rotationDegrees + (i * self centralAngle).
		f extent: self extent.
		f arcColor: self arcColor.
		f centerColor: self centerColor.
		f chordColor: self chordColor.
		f initialSatelliteColor: self initialArrowColor.
		f initialSatelliteColor: self initialSatelliteColor.
		f initialSideColor: self initialSideColor.
		f sectorColor: self sectorColor.
		f segmentColor: self segmentColor.
		f terminalSatelliteColor: self terminalArrowColor.
		f terminalSatelliteColor: self terminalSatelliteColor.
		f terminalSideColor: self terminalSideColor.
		self addMorphCentered: f.
	].! !

!FractionCircleMorph methodsFor: 'accessing' stamp: 'TJ 7/15/2006 16:58'!
initialSatelliteColor: c
	initialSatelliteColor := c..
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f initialSatelliteColor: c]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'accessing' stamp: 'TJ 7/15/2006 16:59'!
initialSideColor: c
	initialSideColor := c..
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f initialSideColor: c]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'accessing' stamp: 'TJ 7/15/2006 16:59'!
sectorColor: c
	sectorColor := c..
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f sectorColor: c]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'accessing' stamp: 'TJ 7/15/2006 17:00'!
segmentColor: c
	segmentColor := c..
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f segmentColor: c]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'accessing' stamp: 'TJ 7/15/2006 17:00'!
terminalSatelliteColor: c
	terminalSatelliteColor := c..
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f terminalSatelliteColor: c]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'accessing' stamp: 'TJ 7/15/2006 17:01'!
terminalSideColor: c
	terminalSideColor := c..
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f terminalSideColor: c]].
	self changed.
! !


!FractionCircleMorph methodsFor: 'initialization' stamp: 'TJ 7/23/2006 09:16'!
initialize
	super initialize.
	self arcColor: (Color black).
	self initialSideColor: (Color black).
	self terminalSideColor: (Color black).
	self divisions: 2.
! !


!FractionCircleMorph methodsFor: 'drawing' stamp: 'TJ 7/16/2006 07:57'!
drawOn: aCanvas
	"Don't draw the fraction circle itself, just the fracture submorphs."! !


!FractionCircleMorph methodsFor: 'halo control' stamp: 'TJ 7/23/2006 09:20'!
rotationDegrees: degrees 
	"for rotating with halo"
	| d |
	d := degrees.
	super rotationDegrees: degrees.
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [
			f rotationDegrees: d. 
			d := d + f centralAngle.
	]].
	self changed.
! !


!FractionCircleMorph methodsFor: 'geometry eToy' stamp: 'TJ 7/23/2006 09:00'!
forwardDirection: newDirection
	"for rotating with halo?"
	super forwardDirection: newDirection.
"Transcript show: 'setting forwardDirection to:'.  Transcript show: newDirection."
	"self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f forwardDirection: newDirection]].
	self changed."
! !

!FractionCircleMorph methodsFor: 'geometry eToy' stamp: 'TJ 7/16/2006 10:25'!
heading: newHeading
	| deltaHeading |
	deltaHeading := newHeading - self heading.
	super heading: newHeading.
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f heading: (f heading + deltaHeading)]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'geometry eToy' stamp: 'TJ 7/16/2006 10:21'!
scaleFactor: newScale 
	super scaleFactor: newScale.
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f scaleFactor: newScale]].
	self changed.
! !


!FractionCircleMorph methodsFor: 'geometry' stamp: 'TJ 7/17/2006 16:15'!
beAngle
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f beAngle]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'geometry' stamp: 'TJ 7/17/2006 16:15'!
beArc
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f beArc]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'geometry' stamp: 'TJ 7/17/2006 16:15'!
beSatellites
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f beSatellites]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'geometry' stamp: 'TJ 7/17/2006 16:15'!
beSector
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f beSector]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'geometry' stamp: 'TJ 7/17/2006 16:16'!
beSegment
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f beSegment]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'geometry' stamp: 'TJ 7/17/2006 16:16'!
beTail
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f beTail]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'geometry' stamp: 'TJ 7/23/2006 09:19'!
extent: newExtent
	"for resizing with halo"
	super extent: newExtent.
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f extent: newExtent]].
	self changed.
! !

!FractionCircleMorph methodsFor: 'geometry' stamp: 'TJ 7/16/2006 10:16'!
slide: s
	slide := s.
	self allMorphsDo: [:f | ((f isKindOf: FractureMorph) and: [(f == self) not]) 
		ifTrue: [f slide: s from: self center]].
		"ifTrue: [f slide: s]]."
	self changed.
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

FractionCircleMorph class
	instanceVariableNames: ''!

!FractionCircleMorph class methodsFor: 'scripting' stamp: 'TJ 7/16/2006 07:20'!
additionsToViewerCategories
	"Answer a list of (<categoryName> <list of category specs>) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories."

^ #(
(#'fraction circle' (

	(slot  divisions  'The number of equal divisions in the fraction circle' Number readWrite Player getDivisions  Player  setDivisions:) 
	(slot  slide  'Move the fractures around like the opening or closing of a camera shutter.  This feature is used to illustrate external angles of regular polygons' Number readWrite Player getSlide  Player  setSlide:) 
)))
! !


!FractionCircleMorph class methodsFor: 'parts bin' stamp: 'TJ 7/18/2006 07:46'!
descriptionForPartsBin
	^ self partName:	'Fraction Circle'
		categories:		#('Fractures')
		documentation:	'A fraction circle composed of fractures.'! !


SimpleSliderMorph subclass: #TapSliderMorph
	instanceVariableNames: 'increment'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'CircularReasoning'!

!TapSliderMorph methodsFor: 'event handling' stamp: 'TJ 7/13/2006 13:58'!
handlesMouseDown: evt

	^ (super handlesMouseDown: evt) or: [evt shiftPressed]! !

!TapSliderMorph methodsFor: 'event handling' stamp: 'TJ 7/14/2006 10:35'!
incrementSlider: evt

	evt cursorPoint y < slider position y
	ifTrue: [self setValue: (self value + self sliderIncrement).] 
	ifFalse: [self setValue: (self value - self sliderIncrement).].
! !

!TapSliderMorph methodsFor: 'event handling' stamp: 'TJ 7/13/2006 14:14'!
mouseDown: evt

	evt shiftPressed 
	"ifTrue: [self setValue: (self value + self increment).] "
	ifTrue: [self incrementSlider: evt.] 
	ifFalse: [super mouseDown: evt].
! !


!TapSliderMorph methodsFor: 'accessing' stamp: 'TJ 7/13/2006 16:04'!
increment
	(increment isNil)
	ifTrue: [^ self defaultIncrement]
	ifFalse: [^ increment].! !

!TapSliderMorph methodsFor: 'accessing' stamp: 'TJ 7/13/2006 16:08'!
increment: i
	increment := i.! !

!TapSliderMorph methodsFor: 'accessing' stamp: 'TJ 7/14/2006 11:00'!
sliderIncrement
	^ self increment / (maxVal - minVal + 1).! !


!TapSliderMorph methodsFor: 'initialization' stamp: 'TJ 7/13/2006 16:15'!
defaultIncrement
	^ 0.01.! !

!TapSliderMorph methodsFor: 'initialization' stamp: 'TJ 7/14/2006 10:37'!
defaultTruncator
	^ 0.01.! !

!TapSliderMorph methodsFor: 'initialization' stamp: 'TJ 7/14/2006 15:28'!
initialize
	super initialize.
	increment := 0.01.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

TapSliderMorph class
	instanceVariableNames: ''!

!TapSliderMorph class methodsFor: 'parts bin' stamp: 'TJ 7/18/2006 07:50'!
descriptionForPartsBin
	^ self partName:	'Tap Slider'
		categories:		#('Scripting')
		documentation:	'A slider with a knob you can move by dragging the knob or shift-clicking (tapping) on the slider.'! !