scaletti@uxc.cso.uiuc.edu (06/12/87)
After looking through the Path hierarchy, I have decided to reimplement much of it to make it cleaner, more general, and also to fix up some bugs present in the code. The following is a fileOut of the new Path hierarchy that I am placing into the public domain. You will notice the addition of a new class, AbstractPath, which provides a cleaner base for subclassing. Please let me know of bugs, comments, etc. Kurt J. Hebel ihnp4!uiucdcs!uiucuxc!scaletti ------------------------------ Cut Here --------------------------------- 'From Smalltalk-80, of May 1, 1987 on 3 June 1987 at 6:39:15 pm'! DisplayObject subclass: #AbstractPath instanceVariableNames: 'form' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Display Objects'! AbstractPath comment: 'AbstractPath is an abstract superclass which defines the protocol common to all Paths. Paths know how to display themselves, and how to transform themselves. They display using the instance variable ''form'' as the writing tool. The basic protocol allows access to the set of points in the Path, and includes support for the protocols defined in the Blue Book, pg. 401.'! !AbstractPath methodsFor: 'point accessing'! add: aPoint "Add this point to the end of the path." self subclassResponsibility.! pointAt: index "Return the point at the index given. This assumes that the points in this Path are represented as an OrderedCollection." ^ self points at: index! pointAt: index put: aPoint "Set the point at the index given. This assumes that the points in this Path are represented as an OrderedCollection." ^ self points at: index put: aPoint! points "Return the collection of points for this Path." ^ self subclassResponsibility! points: aCollection "Set the collection of points for this Path." self subclassResponsibility.! ! !AbstractPath methodsFor: 'accessing'! form "Answer the receiver's form. If the form is nil, then set it to a black dot of size 1." form == nil ifTrue: [form _ Form dotOfSize: 1]. ^ form! form: aForm "Make the argument, aForm, the receiver's form." form _ aForm.! offset "There are basically two kinds of display objects in the system: those that, when asked to transform themselves, create a new object; and those that side effect themselves by maintaining a record of the transformation request (typically an offset). Path, like Rectangle and Point, is a display object of the first kind." self shouldNotImplement! ! !AbstractPath methodsFor: 'transforming'! scaleBy: aPoint "Answer with a new Path scaled by aPoint. Does not effect the current data in this Path." self subclassResponsibility.! translateBy: aPoint "Answer a new instance of Path whose elements are translated by aPoint. Does not effect the elements of this Path." self subclassResponsibility.! ! !AbstractPath methodsFor: 'displaying'! displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm "See comment in DisplayObject|displayOn:at:clippingBox:rule:mask:." self subclassResponsibility.! displayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle "See comment in DisplayObject|displayOn:transformation:clippingBox:" self displayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle rule: Form over mask: Form black! displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger mask: aForm "See comment in DisplayObject|displayOn:transformation:clippingBox:rule:mask:." (aTransformation applyTo: self) displayOn: aDisplayMedium at: 0 @ 0 clippingBox: clipRect rule: anInteger mask: aForm.! ! !AbstractPath methodsFor: 'display box access'! computeBoundingBox "Compute the smallest Rectangle that covers the Path." self subclassResponsibility.! ! !AbstractPath methodsFor: 'Blue Book Compatibility'! at: index "This message is obsolete -- provided for compatibility with the Blue Book." ^ self pointAt: index! at: index put: aPoint "This message is obsolete -- provided for compatibility with the Blue Book." ^ self pointAt: index put: aPoint! collect: aBlock "This message is obsolete -- provided for compatibility with the Blue Book." ^ self points collect: aBlock! do: aBlock "This message is obsolete -- provided for compatibility with the Blue Book." ^ self points do: aBlock! isEmpty "This message is obsolete -- provided for compatibility with the Blue Book." ^ self points isEmpty! removeAllSuchThat: aBlock "This message is obsolete -- provided for compatibility with the Blue Book." ^ self points: (self points reject: aBlock)! select: aBlock "This message is obsolete -- provided for compatibility with the Blue Book." ^ self points select: aBlock! size "This message is obsolete -- provided for compatibility with the Blue Book." ^ self points size! ! AbstractPath subclass: #Arc instanceVariableNames: 'centerPoint radiusPoint beginAngle endAngle' classVariableNames: 'CirclePointTable ScaleFactor' poolDictionaries: '' category: 'Graphics-Paths'! Arc comment: 'This class implements general ellipsoidal arcs given a center point, a radius point (which specifies the x and y radius) and the starting and ending angles of the arc, in degrees.'! !Arc methodsFor: 'accessing'! beginAngle "Answer the beginning angle of this Arc." ^ beginAngle! beginAngle: aNumber "Set the beginning angle of this Arc." beginAngle _ aNumber.! beginAngle: number1 endAngle: number2 "Set the beginning and ending angle of this Arc." beginAngle _ number1. endAngle _ number2.! center "Answer the point at the center of the receiver." ^ centerPoint! center: aPoint "Set aPoint to be the receiver's center." centerPoint _ aPoint.! center: point1 radius: point2 "The receiver is defined by a point at the center and a radius point which gives the radius in the x and y directions." centerPoint _ point1. radiusPoint _ point2 asPoint.! endAngle "Answer the ending angle of this Arc." ^ endAngle! endAngle: aNumber "Set the ending angle of this Arc." endAngle _ aNumber.! radius "Answer the receiver's radius point." ^ radiusPoint! radius: aPoint "Set aPoint to be the receiver's radius point specifying the x and y radii." radiusPoint _ aPoint asPoint.! ! !Arc methodsFor: 'transforming'! scaleBy: aPoint "Answer with a new Path scaled by aPoint. Does not effect the current data in this Path." | anArc | anArc _ self species new. anArc form: self form. anArc beginAngle: beginAngle endAngle: endAngle. anArc center: centerPoint * aPoint. anArc radius: radiusPoint * aPoint. ^ anArc! translateBy: aPoint "Answer with a new Path scaled by aPoint. Does not effect the current data in this Path." | anArc | anArc _ self species new. anArc form: self form. anArc beginAngle: beginAngle endAngle: endAngle. anArc center: centerPoint + aPoint. anArc radius: radiusPoint. ^ anArc! ! !Arc methodsFor: 'displaying'! displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger mask: aForm "Display the receiver as a series of interpolating lines to make an arc. Also, see comment in DisplayObject|displayOn:at:clippingBox:rule:mask:." | deltaAngle aLinearFit startAngle finishAngle | "Compute the starting and finishing angles." startAngle _ beginAngle rounded \\ 360. beginAngle = 360 ifTrue: [startAngle _ 360]. finishAngle _ endAngle rounded \\ 360. endAngle = 360 ifTrue: [finishAngle _ 360]. "Compute the change in angle between each line segment." deltaAngle _ (10 / (radiusPoint x max: radiusPoint y)) radiansToDegrees truncated + 1. startAngle > finishAngle ifTrue: [deltaAngle _ deltaAngle negated]. "Set up the LinearFit for plotting." aLinearFit _ LinearFit new. aLinearFit form: self form. "Add the Arc points to LinearFit." startAngle to: finishAngle by: deltaAngle do: [ :angle | aLinearFit add: (CirclePointTable at: angle + 1) * radiusPoint // ScaleFactor + centerPoint]. aLinearFit add: (CirclePointTable at: finishAngle + 1) * radiusPoint // ScaleFactor + centerPoint. aLinearFit displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger mask: aForm.! ! !Arc methodsFor: 'display box access'! computeBoundingBox "Compute the smallest Rectangle that covers all of the points in the Path." ^ centerPoint - radiusPoint corner: centerPoint + radiusPoint! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Arc class instanceVariableNames: ''! !Arc class methodsFor: 'class initialization'! initialize "Initialize the circle point lookup table." | radians | ScaleFactor _ 2 raisedTo: SmallInteger maxBits - 1. CirclePointTable _ Array new: 361. 0 to: 360 do: [ :degree | radians _ degree degreesToRadians. CirclePointTable at: degree + 1 put: radians cos @ radians sin * ScaleFactor]. "Arc initialize."! ! !Arc class methodsFor: 'examples'! example "Three mousepoints will be requested: the Arc center point, and the beginning and ending points for the Arc." | anArc aForm startPoint endPoint | "Create a black Form for displaying." aForm _ Form new extent: 1 @ 1. aForm black. "Create the Arc and get the parameters from the user." anArc _ Arc new. anArc form: aForm. anArc center: Sensor waitButton. aForm displayAt: anArc center. Sensor waitNoButton. startPoint _ Sensor waitButton. aForm displayAt: startPoint. Sensor waitNoButton. anArc beginAngle: (startPoint - anArc center) theta radiansToDegrees. endPoint _ Sensor waitButton. aForm displayAt: endPoint. Sensor waitNoButton. anArc endAngle: (endPoint - anArc center) theta radiansToDegrees. anArc radius: (startPoint - anArc center) r. "Display the Arc." anArc displayOn: Display. "Arc example."! ! Arc initialize! AbstractPath subclass: #Line instanceVariableNames: 'beginPoint endPoint' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Paths'! Line comment: 'A Line is made up of a beginning Point and an ending Point, in addition to the writing Form defined in the superclass.'! !Line methodsFor: 'point accessing'! add: aPoint "Add this point to the end of the path." beginPoint isNil ifTrue: [^ beginPoint _ aPoint]. endPoint isNil ifTrue: [^ endPoint _ aPoint]. self indexOutOfRangeError.! beginPoint "Answer the beginning point of the receiver." ^ beginPoint! beginPoint: aPoint "Set the beginning point of the receiver. Answer the argument, aPoint." ^ beginPoint _ aPoint! endPoint "Answer the ending point of the receiver." ^ endPoint! endPoint: aPoint "Set the ending point of the receiver." ^ endPoint _ aPoint! pointAt: index "Return the point at the index given." index = 1 ifTrue: [^ beginPoint]. index = 2 ifTrue: [^ endPoint]. self indexOutOfRangeError.! pointAt: index put: aPoint "Set the point at the index given." index = 1 ifTrue: [^ beginPoint _ aPoint]. index = 2 ifTrue: [^ endPoint _ aPoint]. self indexOutOfRangeError.! points "Return the collection of points for this Path." ^ Array with: beginPoint with: endPoint! points: aCollection "Set the collection of points for this Path." beginPoint _ endPoint _ nil. aCollection do: [ :aPoint | self add: aPoint].! ! !Line methodsFor: 'transforming'! scaleBy: aPoint "Answer with a new Path scaled by aPoint. Does not effect the current data in this Path." ^ self species from: beginPoint * aPoint to: endPoint * aPoint withForm: self form! translateBy: aPoint "Answer a new instance of Path whose elements are translated by aPoint. Does not effect the elements of this Path." ^ self species from: beginPoint + aPoint to: endPoint + aPoint withForm: self form! ! !Line methodsFor: 'displaying'! displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger mask: aForm "Display the receiver as a line connecting the beginning point with the ending point using the receiver's form at every point along the line. Also, see comment in DisplayObject|displayOn:at:clippingBox:rule:mask:." aDisplayMedium drawLine: self form from: beginPoint + aPoint to: endPoint + aPoint clippingBox: clipRect rule: anInteger mask: aForm! ! !Line methodsFor: 'display box access'! computeBoundingBox "Compute the smallest Rectangle that covers all of the points in the Path." | minPt maxPt | minPt _ beginPoint min: endPoint. maxPt _ beginPoint max: endPoint. ^ minPt corner: maxPt! ! !Line methodsFor: 'private'! indexOutOfRangeError self error: 'Lines only have 2 points. You tried to access more.'! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Line class instanceVariableNames: ''! !Line class methodsFor: 'instance creation'! from: beginPoint to: endPoint withForm: aForm "Create a new Line with the given arguments." | newSelf | newSelf _ self new. newSelf beginPoint: beginPoint; endPoint: endPoint; form: aForm. ^ newSelf! ! !Line class methodsFor: 'examples'! example "Designate two places on the screen by clicking any mouse button. A straight path with a square black form will be displayed connecting the two selected points." | aLine aForm | "Make a black Form approximately .25 inch square." aForm _ Form new extent: 20@20. aForm black. "Create a Line using this Form for displaying, and using mouse locations for the endpoints." aLine _ Line new. aLine form: aForm. aLine beginPoint: Sensor waitButton. Sensor waitNoButton. aForm displayOn: Display at: aLine beginPoint. aLine endPoint: Sensor waitButton. "Display the Line." aLine displayOn: Display. "Line example."! ! AbstractPath subclass: #Path instanceVariableNames: 'collectionOfPoints' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Paths'! Path comment: 'Path defines a path that includes an arbitrary collection of points. In addition to the protocol defined in the superclass, PointPaths allow access to the collection of points. The instance variable ''collectionOfPoints'' can be any kind of Collection. This class uses the do: message to iterate through the collection of points, and simply displays a copy of its form at each of the given points.'! !Path methodsFor: 'point accessing'! add: aPoint "Add aPoint to the receiver's collection of points in the Path." ^ collectionOfPoints add: aPoint! points "Return the collection of points for this Path." ^ collectionOfPoints! points: aCollection "Set the collection of points for this Path." collectionOfPoints _ aCollection.! ! !Path methodsFor: 'transforming'! scaleBy: aPoint "Answer with a new Path of the same class scaled by aPoint. Does not effect the current data in this Path." | newPath | newPath _ self species on: (collectionOfPoints collect: [ :point | point * aPoint]). newPath form: self form. ^ newPath! translateBy: aPoint "Answer a new instance of Path whose elements are translated by aPoint. Does not effect the elements of this Path." | newPath | newPath _ self species on: (collectionOfPoints collect: [ :point | point + aPoint]). newPath form: self form. ^ newPath! ! !Path methodsFor: 'displaying'! displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm "Display this PointPath as a copy of its form at each point in its collection of points. Also, see comment in DisplayObject|displayOn:at:clippingBox:rule:mask:." | displayForm | displayForm _ self form. collectionOfPoints do: [ :point | displayForm displayOn: aDisplayMedium at: point + aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm].! ! !Path methodsFor: 'display box access'! computeBoundingBox "Compute the smallest Rectangle that covers all of the points in the Path." | minPt maxPt | minPt _ maxPt _ collectionOfPoints at: 1. collectionOfPoints do: [ :aPoint | minPt _ minPt min: aPoint. maxPt _ maxPt max: aPoint]. ^ minPt corner: maxPt! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Path class instanceVariableNames: ''! !Path class methodsFor: 'instance creation'! new "Create a new PointPath with its collection set to a new OrderedCollection." ^ super new points: OrderedCollection new! new: size "Create a new PointPath with its collection set to a new OrderedCollection of the given size." ^ super new points: (OrderedCollection new: size)! on: aCollection "Create a new PointPath with the argument as its collection of points." ^ super new points: aCollection! ! !Path class methodsFor: 'examples'! example "A path is indicated by pressing the red mouse button in sequence; press any other mouse button to terminate. Then displays path again, and also displays offset and with a different form." | aPath aForm point path1 form1 flag | "Create a new path and use the form for the writing tool." aForm _ Form dotOfSize: 1. aPath _ self new. aPath form: aForm. "Collect the mouse point whenever the red button is pressed. Stop collecting on any other button." flag _ true. [flag] whileTrue: [ Sensor waitButton. Sensor redButtonPressed ifTrue: [ point _ Sensor waitButton. aPath add: point. Sensor waitNoButton. aForm displayOn: Display at: point] ifFalse: [flag _ false]]. "Plot the original path." aPath displayOn: Display. "Display the path translated and with a different writing tool." path1 _ aPath translateBy: -100 @ 100. form1 _ Form new extent: 10 @ 40. form1 gray. path1 form: form1. path1 displayOn: Display. "Exit when button left up." Sensor waitNoButton. "Path example."! exampleStar "Display the star example from the Blue Book, pg. 403." | aPath | "Create a new path." aPath _ self new. "Add the points for the star." aPath add: 150 @ 285. aPath add: 400 @ 285. aPath add: 185 @ 430. aPath add: 280 @ 200. aPath add: 375 @ 430. aPath add: 150 @ 285. "Plot the original path." aPath displayOn: Display. "Display the path translated and with a different writing tool." aPath _ aPath translateBy: -100 @ 100. aPath form: (Form extent: 1@10) black. aPath displayOn: Display. "Path exampleStar."! ! Arc subclass: #Circle instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Paths'! Circle comment: 'This class implements general ellipses given a center point and a radius point (which gives the x and y radius).'! !Circle methodsFor: 'accessing'! beginAngle: aNumber "Set the beginning angle of this Circle. Give an error if not 0 degrees." aNumber ~= 0 ifTrue: [self angleError]. beginAngle _ aNumber.! beginAngle: angle1 endAngle: angle2 "Set the beginning and ending angles of this Circle. Give an error if not 0 and 360 degrees, respectively." angle1 ~= 0 | (angle2 ~= 360) ifTrue: [self angleError]. beginAngle _ angle1. endAngle _ angle2.! endAngle: aNumber "Set the ending angle of this Circle. Give an error if not 360 degrees." aNumber ~= 360 ifTrue: [self angleError]. endAngle _ aNumber.! ! !Circle methodsFor: 'private'! angleError self error: 'Illegal beginAngle or endAngle.'.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Circle class instanceVariableNames: ''! !Circle class methodsFor: 'instance creation'! new "Return a new Circle." | aCircle | aCircle _ super new. aCircle beginAngle: 0. aCircle endAngle: 360. ^ aCircle! ! !Circle class methodsFor: 'examples'! exampleOne "Click any button somewhere on the screen. The point will be the center of the circle of radius 150." | aCircle aForm | aForm _ Form new extent: 1@30. aForm black. aCircle _ Circle new. aCircle form: aForm. aCircle radius: 150. aCircle center: Sensor waitButton. aCircle displayOn: Display "Circle exampleOne."! exampleTwo "Designate a rectangular area that should be used as the brush for displaying the circle. Click any button at a point on the screen which will be the center location for the circle." | aCircle aForm | aForm _ Form fromUser. aCircle _ Circle new. aCircle form: aForm. aCircle radius: 150. aCircle center: Sensor waitButton. aCircle displayOn: Display. "Circle exampleTwo."! ! AbstractPath subclass: #Curve instanceVariableNames: 'firstPoint secondPoint thirdPoint' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Paths'! Curve comment: 'A subclass of AbstractPath that is a conic section determined by three points that interpolates the first and the third and is tangent to the angle formed by the three points at the first and third points.'! !Curve methodsFor: 'point accessing'! add: aPoint "Add this point to the end of the path." firstPoint isNil ifTrue: [^ firstPoint _ aPoint]. secondPoint isNil ifTrue: [^ secondPoint _ aPoint]. thirdPoint isNil ifTrue: [^ thirdPoint _ aPoint]. self indexOutOfRangeError.! firstPoint "Answer the first point of the receiver." ^ firstPoint! firstPoint: aPoint "Set the first point of the receiver. Answer the argument, aPoint." ^ firstPoint _ aPoint! pointAt: index "Return the point at the index given." index = 1 ifTrue: [^ firstPoint]. index = 2 ifTrue: [^ secondPoint]. index = 3 ifTrue: [^ thirdPoint]. self indexOutOfRangeError.! pointAt: index put: aPoint "Set the point at the index given." index = 1 ifTrue: [^ firstPoint _ aPoint]. index = 2 ifTrue: [^ secondPoint _ aPoint]. index = 3 ifTrue: [^ thirdPoint _ aPoint]. self indexOutOfRangeError.! points "Return the collection of points for this Path." ^ Array with: firstPoint with: secondPoint with: thirdPoint! points: aCollection "Set the collection of points for this Path." firstPoint _ secondPoint _ thirdPoint _ nil. aCollection do: [ :aPoint | self add: aPoint].! secondPoint "Answer the second point of the receiver." ^ secondPoint! secondPoint: aPoint "Set the second point of the receiver." ^ secondPoint _ aPoint! thirdPoint "Answer the third point of the receiver." ^ thirdPoint! thirdPoint: aPoint "Set the third point of the receiver." ^ thirdPoint _ aPoint! ! !Curve methodsFor: 'transforming'! scaleBy: aPoint "Answer with a new Path scaled by aPoint. Does not effect the current data in this Path." | aCurve | aCurve _ self species new. aCurve form: self form. aCurve firstPoint: firstPoint * aPoint. aCurve secondPoint: secondPoint * aPoint. aCurve thirdPoint: thirdPoint * aPoint. ^ aCurve! translateBy: aPoint "Answer a new instance of Path whose elements are translated by aPoint. Does not effect the elements of this Path." | aCurve | aCurve _ self species new. aCurve form: self form. aCurve firstPoint: firstPoint + aPoint. aCurve secondPoint: secondPoint + aPoint. aCurve thirdPoint: thirdPoint + aPoint. ^ aCurve! ! !Curve methodsFor: 'displaying'! displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger mask: aForm "Display the receiver as a series of interpolating lines to make a curve. Also, see comment in DisplayObject|displayOn:at:clippingBox:rule:mask:." | aLinearFit pa pb numberSegments | "Create a LinearFit for displaying the Curve." aLinearFit _ LinearFit new. aLinearFit form: self form. "Compute the number of line segments to use to approximate the curve." pa _ secondPoint - firstPoint. pb _ thirdPoint - secondPoint. numberSegments _ 5 max: pa x abs + pa y abs + pb x abs + pb y abs // 20. "Add all of the points necessary for the path." aLinearFit add: firstPoint. 1 to: numberSegments do: [ :seg | aLinearFit add: ((pa * seg // numberSegments + firstPoint) * (numberSegments - seg) + ((pb * (seg - 1) // numberSegments + secondPoint) * (seg - 1))) // (numberSegments - 1)]. aLinearFit add: thirdPoint. "Display the LinearFit which is an approximation of this curve." aLinearFit displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger mask: aForm.! ! !Curve methodsFor: 'display box access'! computeBoundingBox "Compute the smallest Rectangle that covers all of the points in the Path." | minPt maxPt | minPt _ (firstPoint min: secondPoint) min: thirdPoint. maxPt _ (firstPoint max: secondPoint) max: thirdPoint. ^ minPt corner: maxPt! ! !Curve methodsFor: 'private'! indexOutOfRangeError self error: 'Curves only have 3 points. You tried to access more.'! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Curve class instanceVariableNames: ''! !Curve class methodsFor: 'examples'! example "Designate three locations on the screen by clicking any button. The curve determined by the points will be displayed with a long black form." | aCurve aForm | "Make a long, thin, black Form for displaying." aForm _ Form new extent: 1@20. aForm black. "Create the Curve from the user's mousepoints." aCurve _ Curve new. aCurve form: aForm. aCurve firstPoint: Sensor waitButton. Sensor waitNoButton. aForm displayOn: Display at: aCurve firstPoint. aCurve secondPoint: Sensor waitButton. Sensor waitNoButton. aForm displayOn: Display at: aCurve secondPoint. aCurve thirdPoint: Sensor waitButton. Sensor waitNoButton. aForm displayOn: Display at: aCurve thirdPoint. "Display the Curve." aCurve displayOn: Display. "Curve example."! ! Path subclass: #Spline instanceVariableNames: 'function firstDerivative secondDerivative thirdDerivative' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Paths'! Spline comment: 'Spline defines a path that includes an arbitrary collection of points connected by a third order curve.'! !Spline methodsFor: 'displaying'! displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger mask: aForm "Display this Spline as a series of approximating lines. Also, see comment in DisplayObject|displayOn:at:clippingBox:rule:mask:." | aLinearFit steps a b c d t | "Make sure that the function and its derivatives are up to date." self validateDerivatives. "Create a LinearFit for plotting." aLinearFit _ LinearFit new. aLinearFit form: self form. aLinearFit add: function first. "Approximate each spline knot." 1 to: function size - 1 do: [ :k | "Compute the Taylor series coefficients." d _ function at: k. c _ firstDerivative at: k. b _ (secondDerivative at: k) / 2.0. a _ (thirdDerivative at: k) / 6.0. "Compute the number of approximating segments." steps _ (secondDerivative at: k) abs + (secondDerivative at: k + 1) abs. steps _ 5 max: (steps x + steps y) // 100. "Add each of the approximating line segments." 1 to: steps do: [ :j | t _ j asFloat / steps. aLinearFit add: a * t + b * t + c * t + d]. "Add the last line to the real spline endpoint." aLinearFit add: (function at: k + 1)]. "Plot the LinearFit which approximates this Spline." aLinearFit displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger mask: aForm.! ! !Spline methodsFor: 'private'! computeCurve "Compute an array for the derivatives at each knot." | size values cyclic second third secondFromLast thirdFromLast | "Get the number of points, and make an OrderedColleciton of all of the points." size _ collectionOfPoints size. function _ OrderedCollection new: size. collectionOfPoints do: [ :point | function addLast: point]. "Exit if the spline has only one point." size = 1 ifTrue: [^ self]. "Flag whether curve is cyclic or not." cyclic _ size > 3 and: [function first = function last]. "Set up the values collection. The derivatives are computed from this." values _ function copy. "Process cyclic curves differently. Add the last two points to the beginning, and the first two points to the end, so that the derivative calculation can look at a cycle." cyclic ifTrue: [ second _ values at: 2. third _ values at: 3. thirdFromLast _ values at: size - 2. secondFromLast _ values at: size - 1. values addFirst: secondFromLast; addFirst: thirdFromLast. values addLast: second; addLast: third]. "Compute the derivatives of the values collection." self computeDerivatives: values. "Remove any extra points which were added if the Spline is cyclic." cyclic ifTrue: [ firstDerivative removeFirst; removeFirst; removeLast; removeLast. secondDerivative removeFirst; removeFirst; removeLast; removeLast. thirdDerivative removeFirst; removeFirst; removeLast; removeLast].! computeDerivatives: values "Computes the first, second and third derivatives at each point in the collection values." | size v b lastV lastB nextV nextB valuesI valuesI1 valuesI2 twoDerivI twoDerivI1 | "Set up the derivative arrays." size _ values size. firstDerivative _ Array new: size. secondDerivative _ Array new: size. thirdDerivative _ Array new: size. "Compute the second derivative of the values." size > 2 ifTrue: [ lastV _ 4.0. lastB _ 6.0 * (values first - ((values at: 2) * 2.0) + (values at: 3)). v _ Array new: size. b _ Array new: size. v at: 1 put: lastV. b at: 1 put: lastB. valuesI _ values at: 2. valuesI1 _ values at: 3. size > 3 ifTrue: [valuesI2 _ values at: 4]. 2 to: size - 2 do: [ :i | nextV _ 4.0 - (1.0 / lastV). nextB _ 6.0 * (valuesI - (valuesI1 * 2.0) + valuesI2) - (lastB / lastV). v at: i put: nextV. b at: i put: nextB. size - 2 = i ifFalse: [ lastV _ nextV. lastB _ nextB. valuesI _ valuesI1. valuesI1 _ valuesI2. valuesI2 _ values at: i + 3]]. secondDerivative at: size - 1 put: nextB / nextV. size - 2 to: 2 by: -1 do: [ :i | secondDerivative at: i put: (b at: i - 1) - (secondDerivative at: i + 1) / (v at: i - 1)]]. secondDerivative at: 1 put: 0.0 asPoint. secondDerivative at: size put: 0.0 asPoint. "Compute the values of the first and third derivative from the second derivative and the values." valuesI _ values at: 1. valuesI1 _ values at: 2. twoDerivI _ secondDerivative at: 1. twoDerivI1 _ secondDerivative at: 2. 1 to: size - 1 do: [ :i | firstDerivative at: i put: valuesI1 - valuesI - (twoDerivI * 2.0 + twoDerivI1 / 6.0). thirdDerivative at: i put: twoDerivI1 - twoDerivI. size - 1 = i ifFalse: [ twoDerivI _ twoDerivI1. twoDerivI1 _ secondDerivative at: i + 2. valuesI _ valuesI1. valuesI1 _ values at: i + 2]]. "The derivative collections should be OrderedCollections." firstDerivative _ firstDerivative asOrderedCollection. secondDerivative _ secondDerivative asOrderedCollection. thirdDerivative _ thirdDerivative asOrderedCollection.! validateDerivatives "Make sure that the function and derivative arrays are still valid. If they are not, recompute them." | index | "Compute the derivatives if the cached function has not been computed." function isNil ifTrue: [^ self computeCurve]. "Compute the derivatives if the cached function and the collection of points do not agree." index _ 1. collectionOfPoints do: [ :point | point ~~ (function at: index) ifTrue: [^ self computeCurve]. index _ index + 1].! ! !Spline methodsFor: 'accessing'! ! Path subclass: #LinearFit instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Paths'! LinearFit comment: 'LinearFit defines a path that includes an arbitrary collection of points connected by lines.'! !LinearFit methodsFor: 'displaying'! displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger mask: aForm "Display this LinearFit as a line connecting each pair of points in its collection of points. Also, see comment in DisplayObject|displayOn:at:clippingBox:rule:mask:." | line | line _ Line new. line form: self form. collectionOfPoints inject: nil into: [ :lastPt :thisPt | lastPt ~~ nil ifTrue: [ line beginPoint: lastPt. line endPoint: thisPt. line displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger mask: aForm]. thisPt].! !