'From Squeak3.9alpha of ''2 November 2004'' [latest update: #6404] on 6 November 2004 at 11:55:55 pm'!
"Change Set: CurvierCurves-wiz
Date: 18 July 2004
Author: Jerome Peace (wiz)
CurvierCurves is a revision of NewCurves for the sole purpose of revising the name.
CurvierMorph is a subclass of CurveMorph (for now). It uses a true closed curve cubic smoothing for closed curves this eliminates the 'corner' of the closed CurveMorph. CurvierCurves look the same regardless of which vertice you start with or which direction they are traversed.
In the process of writing this I considerably rewrote the smoothing methods and refactored stuff to be much more reusable.
Also in the process I made changes to PolygonMorph to make them safe for one vertex polygons. Also fixed some inaccuracies in smoothing that are hidden by the less demanding code currently in use.
CurvierMorph wants to be merged completely into Polygon and to become curve morph. In deference to the great number of subclasses of Polygon it appears separately first. It is my hope that it can appear in 3.9 to jazz up the curve drawing abilities.
What I have here is solid and very usable. It tests out AOK when loaded into a fresh image. (Most recently 3.9a-6404).
I tried to make a package of it but was stymied by the changes I made to PolygonMorph. Those are fixes or general enhancements so they belong there. So I have settled for this change set inorder to get these enhancements/fixes before your eyes.
wiz 7/19/2004 00:30 Version 5. Fixed name of pref flag in last version. Fixed morph name for flap registry. new curves appear in object catalog now. They don't yet appear in Supplies flap.
Version 6. Postamble now set to initialize CurvierMorph class."!
!PolygonMorph commentStamp: '' prior: 0!
This class combines the old Polygon and Curve classes.
The 1-bit fillForm to make display and containment tests reasonably fast. However, this functionality is in the process of being supplanted by balloon capabilities, which should eventually provide anti-aliasing as well.
wiz 7/18/2004 21:26
s have made some changes to this class to
1) correct some bugs associated with one vertex polygons.
2) prepare for some enhancements with new curves.
3) add shaping items to menu.!
Smalltalk renameClassNamed: #NewCurveMorph as: #CurvierMorph!
CurveMorph subclass: #CurvierMorph
instanceVariableNames: ''
classVariableNames: 'SlopeConstantsCache'
poolDictionaries: ''
category: 'newCurve-Morphic-Basic'!
!CurvierMorph commentStamp: '' prior: 0!
I want to be merged into PolygonMorph.
I implement Closed Cubic Curves and restructured routines to ease maintence and development.
New way to calculate curves.
cVariables
SlopeConstantsCache anArray size 2 indexed by nVerts \\2 .
Each element is an array of integers. The integers represent the constants for
calculating slopes for closed cubic curves from the vertices.
Class Variable SlopeConstantsCache holds a pair of arrays for even and odd number of vertices( aka knots).
Each array holds a series of constants in Integer form.
This allows slopes to be calculated directly from the array of knots.
Wonderfully it turns out that only two arrays are needed.
By matching up the knots equidistant from the point in question;
Summing the weighted differences of the pairs the unscaled slope can be arrived at.
The scale needed to get the slopes needed is trice the reciprical of the next integer in the series.
We leave the division til last to get the full benifit of the integer arithmetic.
Rounding the vertices before calculation is recommended.
Instead of calculating the number of curve subsegments in lineSegDo we add a ninth array to curve state to allow the number to be precalculated.
Getting better looking curves motivates finding a better way of guessing n. So this provides a framework for trying.
For the first pass we just used the constant 12 for every thing.
In the second pass we judge the number of segments by starting with two and doubling the number until the distance of the curve no longer increases.
Then we hone in using a binary search to find the smallest number of segments with that same curve length.
We have changed some assumptions. Previously curves were figured by solving for the second derivative first and using the results to determine the slope and the third derivative. So lineSegDo counted on the last second deriv being a number it could use in its calculation of the number of subsegments.
Currently we just solve for slopes and the second and third derivs are derived from that.
Also the derivation for the second and third derivs only assume C(1) (first derivitive continuity). The calculations for the slopes are the only calcs using C(2) continuity. Therefore the slopes can alternately be chosen to fit some other chriteria and the resulting curves will still be smooth to the first degree.
A useful variant of closed slopes is to scale them by a constant.
Also the last of each element of curvestate always reflects a closing segment. And we don't add an extra row for closed curves anymore.
That is now lineSegDo's responsibility to be aware of as it was already doing with segmented curves. So the last n does not track its old value.
Preferences:
A Preference has been added to toggle between the old (ugly) closed curves based on natural cubic slopes and the new smooth algorythim. This doesn't make much difference while newcurves are a subclass of polygons but the ambition is for newcurves to supercede polygons. This will allow backwards compatibility.
Shapes: With closed curves a smooth oval results from rectagular or diamond vertices. So two menuitems have been added (to PolygonMorph) that allow the vertices to be set to these shapes using the current bounds of the polygon. The former state of vertices will be lost but it seems useful to lose a complicated shape and start fresh with a simple symmetrical one.
Furthur on: Modify curveState to only contain slope and higher deriv information. Let the information about the knots only be held only in the vertices of the polygon. Once that is done curvestate will not have to be recalcutaled each time the polygon is moved but only when its shape changes.
There is also some possible speed up to be had by refining or experimenting with other number of segment calculating schemes but not as much as preserving curvestate over a move.
Furthur furthur on: Figure out how to combine straight and curved segments into a single shape in a pleasing way.
!
Array variableSubclass: #Cubic
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Collections-Arrayed'!
!Cubic commentStamp: 'wiz 6/17/2004 20:31' prior: 0!
I am a segment between to points. In the form of a cubic polynomial that can be evaluated between 0..1 to obtain the end points and intermediate values.
!
!Object methodsFor: '*newCurve-tests' stamp: 'wiz 7/15/2004 14:06'!
isNonZero
"Return true for numbers not zero and false for all other objects"
^ self isNumber and: [self isZero not]! !
!Integer methodsFor: '*newCurve-support' stamp: 'wiz 7/18/2004 17:00'!
cacheForClosedCubicSolution
"Return a pair of arrays representing the integer series of
weights for calculating closed cubic slopes.
The series will be at least long enough to calculate slopes for the
receivers number of vertices.
The first of the two arrays is for even vertices the second for odd."
"| n |
^ ((n := 100
max: (self odd
ifTrue: [self + 5]
ifFalse: [self + 6])) to: n + 1)
collect: [:i | i calcClosedCubicSolution first reverse]"
"For simplicity calculate the cache w/o using half arrays this time."
"zed is a constant"
| n evenWeights oddWeights zed minN |
zed := #(0 ).
"minN is a constant"
minN := 18.
"A cache for n=18 will be plenty for most situations. The first 16 weights
will be small integers the rest large. n=18 generates the first 16 odd
and even weights."
n := minN max: self // 2 + 6.
evenWeights := Array new: n withAll: 0.
evenWeights at: 1 put: 1.
(2 to: n - 2)
do: [:i |
evenWeights at: i incrementBy: (evenWeights at: i - 1)
* 4 negated.
evenWeights at: i + 1 incrementBy: (evenWeights at: i - 1) negated].
oddWeights := evenWeights + (zed , evenWeights allButLast).
^ {evenWeights allButLast: 2. oddWeights allButLast: 2}! !
!PolygonMorph methodsFor: 'access' stamp: 'wiz 6/24/2004 22:50'!
midVertices
"Return and array of midpoints for this line or closed curve"
| midPts nextVertIx tweens |
vertices size < 2
ifTrue: [^ vertices].
midPts := OrderedCollection new.
nextVertIx := 2.
tweens := OrderedCollection new.
tweens add: vertices first asIntegerPoint.
"guarantee at least two points."
self
lineSegmentsDo: [:p1 :p2 |
tweens addLast: p2 asIntegerPoint.
p2
= (vertices atWrap: nextVertIx)
ifTrue: ["Found endPoint."
midPts addLast: (tweens atWrap: tweens size + 1 // 2)
+ (tweens at: tweens size // 2 + 1) // 2.
"wiz 6/19/2004 20:11 adjusted to handle
one segment properly"
tweens := OrderedCollection new.
tweens add: p2 asIntegerPoint.
"guarantee at least two points."
nextVertIx := nextVertIx + 1]].
^ midPts asArray! !
!PolygonMorph methodsFor: 'debug and other' stamp: 'wiz 5/1/2004 00:21'!
rotateTestFlip: aBool
"Return one copy of me for each vertex using each vertex as
the
starting point.
Vary to border color to destinguish the copies.
This tests closed curves for their consistency.
The flip boolean tests the reversed rotations."
| len colors verts flip |
verts := self vertices.
flip := aBool == true
ifTrue: [1]
ifFalse: [0].
len := verts size.
colors := Color wheel: len*2 .
(1 to: len)
do: [:i | | j | (self copy
borderColor: (colors at: (j:=i * 2 - flip));
yourself)
setVertices: (verts flipRotated: j);
openInWorld]! !
!PolygonMorph methodsFor: 'drawing' stamp: 'wiz 6/22/2004 16:06'!
drawArrowsOn: aCanvas
"Answer (possibly modified) endpoints for border drawing"
"ArrowForms are computed only upon demand"
| array |
self hasArrows
ifFalse: [^ self].
"Nothing to do"
borderColor isColor
ifFalse: [^ self].
array := Array new: 2.
"Prevent crashes for #raised or #inset borders"
array
at: 2
put: ((arrows == #forward
or: [arrows == #both])
ifTrue: [self
drawArrowOn: aCanvas
at: vertices last
from: self nextToLastPoint]
ifFalse: [vertices last]).
array
at: 1
put: ((arrows == #back
or: [arrows == #both])
ifTrue: [self
drawArrowOn: aCanvas
at: vertices first
from: self nextToFirstPoint]
ifFalse: [vertices first]).
^ array! !
!PolygonMorph methodsFor: 'drawing' stamp: 'wiz 6/22/2004 15:56'!
drawBorderOn: aCanvas usingEnds: anArray
"Display my border on the canvas."
"NOTE: Much of this code is also copied in
drawDashedBorderOn:
(should be factored)"
| bigClipRect p1i p2i style |
borderDashSpec
ifNotNil: [^ self drawDashedBorderOn: aCanvas usingEnds: anArray].
style := self borderStyle.
bigClipRect := aCanvas clipRect expandBy: self borderWidth + 1 // 2.
self
lineSegmentsDo: [:p1 :p2 |
p1i := p1 asIntegerPoint.
p2i := p2 asIntegerPoint.
self hasArrows
ifTrue: ["Shorten line ends so as not to interfere with tip
of arrow."
((arrows == #back
or: [arrows == #both])
and: [p1 = vertices first])
ifTrue: [p1i := anArray first asIntegerPoint].
((arrows == #forward
or: [arrows == #both])
and: [p2 = vertices last])
ifTrue: [p2i := anArray last asIntegerPoint]].
(closed
or: ["bigClipRect intersects: (p1i rect: p2i)
optimized:"
((p1i min: p2i)
max: bigClipRect origin)
<= ((p1i max: p2i)
min: bigClipRect corner)])
ifTrue: [style
drawLineFrom: p1i
to: p2i
on: aCanvas]]! !
!PolygonMorph methodsFor: 'drawing' stamp: 'wiz 6/22/2004 15:56'!
drawDashedBorderOn: aCanvas usingEnds: anArray
"Display my border on the canvas. NOTE: mostly copied from
drawBorderOn:"
| lineColor bevel topLeftColor bottomRightColor bigClipRect p1i p2i segmentOffset |
(borderColor isNil
or: [borderColor isColor
and: [borderColor isTransparent]])
ifTrue: [^ self].
lineColor := borderColor.
bevel := false.
"Border colors for bevelled effects depend on CW ordering of
vertices"
borderColor == #raised
ifTrue: [topLeftColor := color lighter.
bottomRightColor := color darker.
bevel := true].
borderColor == #inset
ifTrue: [topLeftColor := owner colorForInsets darker.
bottomRightColor := owner colorForInsets lighter.
bevel := true].
bigClipRect := aCanvas clipRect expandBy: self borderWidth + 1 // 2.
segmentOffset := self borderDashOffset.
self
lineSegmentsDo: [:p1 :p2 |
p1i := p1 asIntegerPoint.
p2i := p2 asIntegerPoint.
self hasArrows
ifTrue: ["Shorten line ends so as not to interfere with tip
of arrow."
((arrows == #back
or: [arrows == #both])
and: [p1 = vertices first])
ifTrue: [p1i := anArray first asIntegerPoint].
((arrows == #forward
or: [arrows == #both])
and: [p2 = vertices last])
ifTrue: [p2i := anArray last asIntegerPoint]].
(closed
or: ["bigClipRect intersects: (p1i rect: p2i)
optimized:"
((p1i min: p2i)
max: bigClipRect origin)
<= ((p1i max: p2i)
min: bigClipRect corner)])
ifTrue: [bevel
ifTrue: [lineColor := (p1i quadrantOf: p2i)
> 2
ifTrue: [topLeftColor]
ifFalse: [bottomRightColor]].
segmentOffset := aCanvas
line: p1i
to: p2i
width: borderWidth
color: lineColor
dashLength: borderDashSpec first
secondColor: borderDashSpec third
secondDashLength: borderDashSpec second
startingOffset: segmentOffset]]! !
!PolygonMorph methodsFor: 'editing' stamp: 'wiz 7/18/2004 23:01'!
addHandles
"Put moving handles at the vertices. Put adding handles at edge
midpoints. Moving over adjacent vertex and dropping will delete a
vertex. "
| handle newVert tri |
self removeHandles.
handles := OrderedCollection new.
tri := Array
with: 0 @ -4
with: 4 @ 3
with: -3 @ 3.
vertices
withIndexDo: [:vertPt :vertIndex |
handle := EllipseMorph
newBounds: (Rectangle center: vertPt extent: 8 @ 8)
color: Color yellow.
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.
(closed
or: [1 = vertices size
"Give a small polygon a chance to grow. -wiz"]
or: [vertIndex < vertices size])
ifTrue: [newVert := PolygonMorph
vertices: (tri
collect: [:p | p + (vertPt
+ (vertices atWrap: vertIndex + 1) // 2)])
color: Color green
borderWidth: 1
borderColor: Color black.
newVert
on: #mouseDown
send: #newVertex:event:fromHandle:
to: self
withValue: vertIndex.
self addMorph: newVert.
handles addLast: newVert]].
smoothCurve
ifTrue: [self updateHandles; layoutChanged].
self changed! !
!PolygonMorph methodsFor: 'editing' stamp: 'wiz 7/18/2004 23:08'!
dropVertex: ix event: evt fromHandle: handle
"Leave vertex in new position. If dropped ontop another vertex delete this one.
Check for too few vertices before deleting. The alternative
is not pretty -wiz"
| p |
p := vertices at: ix.
(vertices size >= 2
and: ["check for too few vertices before deleting. The alternative
is not pretty -wiz"
((vertices atWrap: ix - 1)
dist: p)
< 3
or: [((vertices atWrap: ix + 1)
dist: p)
< 3]])
ifTrue: ["Drag a vertex onto its neighbor means delete"
self
setVertices: (vertices
copyReplaceFrom: ix
to: ix
with: Array new)].
evt shiftPressed
ifTrue: [self removeHandles]
ifFalse: [self addHandles
"remove then add to recreate"]! !
!PolygonMorph methodsFor: 'editing' stamp: 'wiz 6/24/2004 23:03'!
updateHandles
| newVert oldVert |
self isCurvy
ifTrue: [handles first center: vertices first.
handles last center: vertices last.
self midVertices
withIndexDo: [:midPt :vertIndex | (closed
or: [vertIndex < vertices size])
ifTrue: [newVert := handles atWrap: vertIndex * 2.
newVert position: midPt - (newVert extent // 2)]]]
ifFalse: [vertices
withIndexDo: [:vertPt :vertIndex |
oldVert := handles at: vertIndex * 2 - 1.
oldVert position: vertPt - (oldVert extent // 2).
(closed
or: [vertIndex < vertices size])
ifTrue: [newVert := handles at: vertIndex * 2.
newVert position: vertPt
+ (vertices atWrap: vertIndex + 1) - newVert extent // 2 + (1 @ -1)]]]! !
!PolygonMorph methodsFor: 'menu' stamp: 'wiz 7/18/2004 17:58'!
addCustomMenuItems: aMenu hand: aHandMorph
| lineName |
super addCustomMenuItems: aMenu hand: aHandMorph.
aMenu
addUpdating: #handlesShowingPhrase
target: self
action: #showOrHideHandles.
vertices size > 2
ifTrue: [aMenu
addUpdating: #openOrClosePhrase
target: self
action: #makeOpenOrClosed.
lineName := (closed
ifTrue: ['outline']
ifFalse: ['line']) translated.
self isCurve
ifTrue: [aMenu
add: ('make segmented {1}' translated format: {lineName})
action: #toggleSmoothing]
ifFalse: [aMenu
add: ('make smooth {1}' translated format: {lineName})
action: #toggleSmoothing]].
aMenu add: 'specify dashed line' translated action: #specifyDashedLine.
"aMenu add: 'use debug border' translated action: #showSegmentsBorderStyle."
self isOpen
ifTrue: [aMenu addLine.
aMenu
addWithLabel: '---'
enablement: [self isOpen
and: [arrows ~~ #none]]
action: #makeNoArrows.
aMenu
addWithLabel: '-->'
enablement: [self isOpen
and: [arrows ~~ #forward]]
action: #makeForwardArrow.
aMenu
addWithLabel: '<--'
enablement: [self isOpen
and: [arrows ~~ #back]]
action: #makeBackArrow.
aMenu
addWithLabel: '<->'
enablement: [self isOpen
and: [arrows ~~ #both]]
action: #makeBothArrows.
aMenu add: 'customize arrows' translated action: #customizeArrows:.
(self hasProperty: #arrowSpec)
ifTrue: [aMenu add: 'standard arrows' translated action: #standardArrows]]
ifFalse: [aMenu addLine.
aMenu
addWithLabel: 'make inscibed diamondOval'
enablement: [self isClosed ]
action: #diamondOval.
aMenu
addWithLabel: 'make enclosing rectangleOval'
enablement: [self isClosed ]
action: #rectOval.
]! !
!PolygonMorph methodsFor: 'testing' stamp: 'wiz 7/18/2004 23:00'!
hasArrows
"Are all the conditions meet for having arrows?"
^ (closed
or: [arrows == #none
or: [vertices size < 2]]) not! !
!PolygonMorph methodsFor: 'testing' stamp: 'wiz 5/2/2004 22:03'!
isCurvy
"Test for significant curves.
Small smoothcurves in practice are straight."
^ smoothCurve
and: [vertices size > 2]! !
!PolygonMorph methodsFor: 'private' stamp: 'wiz 6/22/2004 15:54'!
arrowForms
"ArrowForms are computed only upon demand"
arrowForms
ifNotNil: [^ arrowForms].
arrowForms := Array new.
self hasArrows
ifFalse: [^ arrowForms].
(arrows == #forward
or: [arrows == #both])
ifTrue: [arrowForms := arrowForms
copyWith: (self computeArrowFormAt: vertices last from: self nextToLastPoint)].
(arrows == #back
or: [arrows == #both])
ifTrue: [arrowForms := arrowForms
copyWith: (self computeArrowFormAt: vertices first from: self nextToFirstPoint)].
^ arrowForms! !
!PolygonMorph methodsFor: 'shaping' stamp: 'wiz 7/18/2004 23:05'!
diamondOval
"Retrun an array of edge midpoint vertices.
Order of vertices is in the tradion of warpblt quads."
| b r |
b := self bounds.
r := {b leftCenter. b bottomCenter. b rightCenter. b topCenter}.
self setVertices: r! !
!PolygonMorph methodsFor: 'shaping' stamp: 'wiz 7/18/2004 23:03'!
rectOval
"Retrun an array of corner vertices.
Order of vertices is in the tradion of warpblt quads."
| b r |
b := self bounds.
r := {b topLeft. b bottomLeft. b bottomRight. b topRight}.
self setVertices: r! !
!CurvierMorph methodsFor: 'testing' stamp: 'wiz 7/18/2004 22:53'!
hasArrows
"Are all the conditions meet for having arrows?"
^ (closed
or: [arrows == #none
or: [vertices size < 2]]) not! !
!CurvierMorph methodsFor: 'testing' stamp: 'wiz 5/2/2004 22:02'!
isCurvy
"Test for significant curves.
Small smoothcurves in practice are straight."
^(smoothCurve
and: [vertices size > 2]) ! !
!CurvierMorph methodsFor: 'editing' stamp: 'wiz 7/18/2004 22:56'!
addHandles
"Put moving handles at the vertices. Put adding handles at edge midpoints.
Moving over adjacent vertex and dropping will delete a vertex."
| handle newVert tri |
self removeHandles.
handles := OrderedCollection new.
tri := Array
with: 0 @ -4
with: 4 @ 3
with: -3 @ 3.
vertices
withIndexDo: [:vertPt :vertIndex |
handle := EllipseMorph
newBounds: (Rectangle center: vertPt extent: 8 @ 8)
color: Color yellow.
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.
(closed
or: [1 = vertices size
"Give a small polygon a chance to grow.
-wiz"]
or: [vertIndex < vertices size])
ifTrue: [newVert := PolygonMorph
vertices: (tri
collect: [:p | p + (vertPt
+ (vertices atWrap: vertIndex + 1) // 2)])
color: Color green
borderWidth: 1
borderColor: Color black.
newVert
on: #mouseDown
send: #newVertex:event:fromHandle:
to: self
withValue: vertIndex.
self addMorph: newVert.
handles addLast: newVert]].
self isCurvy
ifTrue: [self updateHandles; layoutChanged].
self changed! !
!CurvierMorph methodsFor: 'private' stamp: 'wiz 7/18/2004 22:57'!
curveBounds
| curveBounds pointAfterFirst pointBeforeLast |
"Compute the bounds from actual curve traversal, with
leeway for borderWidth.
Also note the next-to-first and next-to-last points for arrow
directions."
self isCurvy
ifFalse: [^ (Rectangle encompassing: vertices)
expandBy: borderWidth + 1 // 2].
curveState := nil.
"Force recomputation"
curveBounds := vertices first corner: vertices last.
pointAfterFirst := nil.
self
lineSegmentsDo: [:p1 :p2 |
pointAfterFirst isNil
ifTrue: [pointAfterFirst := p2 asIntegerPoint.
curveBounds := curveBounds encompass: p1 asIntegerPoint].
curveBounds := curveBounds encompass: p2 asIntegerPoint.
pointBeforeLast := p1 asIntegerPoint].
curveState at: 2 put: pointAfterFirst.
curveState at: 3 put: pointBeforeLast.
^ curveBounds expandBy: borderWidth + 1 // 2! !
!CurvierMorph methodsFor: 'smoothing' stamp: 'wiz 11/6/2004 23:31'!
coefficients
"Compute an array for the coefficients."
| verts vertXs vertYs slopeXs slopeYs coefficients |
curveState
ifNotNil: [^ curveState at: 1].
verts := self vertices.
verts size < 1
ifTrue: [^ self].
"Less than three points handled as segments by our
lineSegmentsDo:"
(Preferences valueOfFlag: #Curvier)
ifFalse: [closed
ifTrue: [verts := verts , verts first asOrderedCollection]].
coefficients := {vertXs := verts
collect: [:p | p x asFloat]. slopeXs := self slopes: vertXs. vertXs changeInSlopes: slopeXs. vertXs changeOfChangesInSlopes: slopeXs. vertYs := verts
collect: [:p | p y asFloat]. slopeYs := self slopes: vertYs. vertYs changeInSlopes: slopeYs. vertYs changeOfChangesInSlopes: slopeYs. Array new: verts size withAll: 12}.
coefficients
at: 9
put: ((1 to: verts size)
collect: [:i | (coefficients cubicPointPolynomialAt: i) bestSegments]).
(Preferences valueOfFlag: #Curvier)
ifFalse: [closed
ifTrue: [coefficients := coefficients
collect: [:each | each allButLast]]].
curveState := {coefficients. nil. nil}.
self computeNextToEndPoints.
^ coefficients! !
!CurvierMorph methodsFor: 'smoothing' stamp: 'wiz 6/19/2004 23:36'!
lineSegmentsDo: endPointsBlock
"Emit a sequence of segment endpoints into endPointsBlock."
"Unlike the method this one overrides we expect the curve
coefficents not the dirivatives"
"Also unlike the overiden method the smooth closed curve does
not need an extra vertex.
We take care of the extra endpoint here. Just like for
segmented curves."
| n t x y x1 x2 x3 y1 y2 y3 beginPoint endPoint cs |
vertices size < 1
ifTrue: [^ self].
"test too few vertices first"
self isCurvy
ifFalse: [beginPoint := nil.
"smoothCurve
ifTrue: [cs := self coefficients]."
"some things still depend on smoothCurves having
curveState"
vertices
do: [:vert |
beginPoint
ifNotNil: [endPointsBlock value: beginPoint value: vert].
beginPoint := vert].
(closed
or: [vertices size = 1])
ifTrue: [endPointsBlock value: beginPoint value: vertices first].
^ self].
"For curves we include all the interpolated sub segments."
"self assert: [(vertices size > 2 )]. "
cs := self coefficients.
beginPoint := (x := cs first first) @ (y := cs fifth first).
(closed
ifTrue: [1 to: cs first size]
ifFalse: [1 to: cs first size - 1])
do: [:i |
"taylor series coefficients"
x1 := cs second at: i.
y1 := cs sixth at: i.
x2 := cs third at: i.
y2 := cs seventh at: i.
x3 := cs fourth at: i.
y3 := cs eighth at: i.
n := cs ninth at: i.
"guess n
n := 5 max: (x2 abs + y2 abs * 2.0 + (cs third atWrap: i
+ 1) abs + (cs seventh atWrap: i + 1) abs / 100.0)
rounded. "
1
to: n - 1
do: [:j |
t := j asFloat / n asFloat.
endPoint := x3 * t + x2 * t + x1 * t + x @ (y3 * t + y2 * t + y1 * t + y).
endPointsBlock value: beginPoint value: endPoint.
beginPoint := endPoint].
endPoint := (x := cs first atWrap: i + 1) @ (y := cs fifth atWrap: i + 1).
endPointsBlock value: beginPoint value: endPoint.
beginPoint := endPoint]! !
!CurvierMorph methodsFor: 'smoothing' stamp: 'wiz 5/4/2004 00:27'!
nextToFirstPoint
"For arrow direction"
self isCurvy
ifTrue: [curveState
ifNil: [self coefficients].
^ curveState second]
ifFalse: [^ vertices second]! !
!CurvierMorph methodsFor: 'smoothing' stamp: 'wiz 5/4/2004 00:26'!
nextToLastPoint
"For arrow direction"
self isCurvy
ifTrue: [curveState
ifNil: [self coefficients].
^ curveState third]
ifFalse: [^ vertices at: vertices size - 1]! !
!CurvierMorph methodsFor: 'smoothing' stamp: 'wiz 11/6/2004 23:32'!
slopes: knots
"Choose slopes according to state of polygon and preferences"
self isCurvy
ifFalse: [^ knots segmentedSlopes].
^ (closed
and: [Preferences valueOfFlag: #Curvier])
ifTrue: [knots closedCubicSlopes]
ifFalse: [knots naturalCubicSlopes]! !
!CurvierMorph methodsFor: 'initialization' stamp: 'wiz 7/18/2004 22:53'!
initialize
"We use an oval shape because we wear it well."
super initialize.
self diamondOval! !
!CurvierMorph class methodsFor: 'accessing' stamp: 'wiz 6/20/2004 00:01'!
weightsFor: index
"Insure we have cached enough weights for index vertices.
Return the weights matching index's parity."
| planB |
index isNonZero
ifFalse: [self error: 'Index must be nonzero integer'].
planB := [SlopeConstantsCache := index cacheForClosedCubicSolution].
(SlopeConstantsCache ifNil: planB) first size * 2 > index ifFalse: planB.
^ SlopeConstantsCache at: index \\ 2 + 1! !
!CurvierMorph class methodsFor: 'parts bin' stamp: 'wiz 11/6/2004 23:24'!
descriptionForPartsBin
"We are very much like curve only better looking."
^ self
partName: 'Curvier'
categories: #('Graphics' 'Basic' )
documentation: 'A smooth wiggly curve, or a smooth curved solid without bends. Shift-click to get handles and move the points.'! !
!CurvierMorph class methodsFor: 'class initialization' stamp: 'wiz 11/6/2004 23:16'!
initialize
"CurvierMorph initialize"
Preferences
preferenceAt: #Curvier
ifAbsent: [Preferences
addPreference: #Curvier
category: #morphic
default: true
balloonHelp: 'if true, closed CurvierMorphs will be smoother and more symmetrical all about. If false they will mimic the old curve shapes with the one sharp bend.'].
self registerInFlapsRegistry! !
!CurvierMorph class methodsFor: 'class initialization' stamp: 'wiz 11/6/2004 23:17'!
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
ifPresent: [:cl |
cl registerQuad: #(#CurvierMorph #authoringPrototype 'Curvier' 'A curve' ) forFlapNamed: 'PlugIn Supplies'.
cl registerQuad: #(#CurvierMorph #authoringPrototype 'Curvier' 'A curve' ) forFlapNamed: 'Supplies']! !
!SequenceableCollection methodsFor: '*newCurves-cubic support' stamp: 'wiz 7/18/2004 23:12'!
asCubic
"Convert this point array to a Cubic object"
self
assert: [self size = 4].
self
assert: [self
allSatisfy: [:each | each isPoint]].
^ Cubic withAll: self! !
!SequenceableCollection methodsFor: '*newCurves-cubic support' stamp: 'wiz 5/2/2004 15:47'!
changeInSlopes: slopes
"A message to knots of a spline. Returns an array with the 3rd cubic coeff."
"The last nth item is correct iff this is a closed cubic.
Presumably that is the only time we care.
We alway return the same sized array as self."
| n slopeChanges |
n := self size.
n = slopes size
ifFalse: [^ self error: 'vertices and slopes differ in number'].
slopeChanges := Array new: n.
(1 to: n)
do: [:i | slopeChanges at: i put: (self atWrap: i + 1)
- (self at: i) * 3 - ((slopes at: i)
* 2)
- (slopes atWrap: i + 1)].
^ slopeChanges! !
!SequenceableCollection methodsFor: '*newCurves-cubic support' stamp: 'wiz 5/2/2004 15:53'!
changeOfChangesInSlopes: slopes
"A message to knots of a spline. Returns an array with the 4rd
cubic coeff."
"The last nth item is correct iff this is a closed cubic.
Presumably that is the only time we care.
We alway return the same sized array as self."
| n changes |
n := self size.
n = slopes size
ifFalse: [^ self error: 'vertices and slopes differ in number'].
changes := Array new: n.
(1 to: n)
do: [:i | changes at: i put: (self at: i)
- (self atWrap: i + 1) * 2
+ (slopes at: i)
+ (slopes atWrap: i + 1)].
^ changes! !
!SequenceableCollection methodsFor: '*newCurves-cubic support' stamp: 'wiz 11/6/2004 23:12'!
closedCubicSlopes
"Like closed cubic but returns Cubic w/o the repeated first
point at the end."
"Takes a collection of numbers or points representing the knots
and returns the slopes."
"Uses a method exploiting the symmetries of the closed cubic.
From the number of knots (vertices) alone the closed solution
for any slope as a function of the knots is obtained.
It consists of a half array and a scale.
For simplicity we solve for 1/3 the slope and then adjust the
scale to compensate.
Using that to calculate two adjacent slopes and then use those
slopes to calculate all the others from the equation
b0=a2-a0-b2-4b1.
Finally all slopes are scaled.
The advantages are we can work with integers until late in the
calculation. If we are careful to use integer points for vertices
only the scaling is non-integer.
And all the weights are precalculated and stored in pool
variables. So that doesn't have to take much time either.
And since we are working with halfarrays; half the work.
ehh?"
| nVerts scale weights |
nVerts := self size.
weights := CurvierMorph weightsFor: nVerts.
scale := weights at: nVerts + 1 // 2.
^ (self
unscaledSlopesAt: nVerts
with: (self unscaledClosedCubicSlopeAt: nVerts using: weights)
nextTo: (self unscaledClosedCubicSlopeAt: 1 using: weights)
atScale: scale)
* (3 / scale) asFloat! !
!SequenceableCollection methodsFor: '*newCurves-cubic support' stamp: 'wiz 7/18/2004 23:18'!
cubicPointPolynomialAt: vIndex
"From curve information assemble a 4-array of points representing the coefficents for curve segment between to points. Beginning point is first point in array endpoint is the pointSum of the array. Meant to be sent to newcurves idea of curve coefficents."
^ ((1 to: 4)
collect: [:i | ((self at: i)
at: vIndex)
@ ((self at: 4 + i)
at: vIndex)]) asCubic! !
!SequenceableCollection methodsFor: '*newCurves-cubic support' stamp: 'wiz 5/2/2004 14:36'!
naturalCubicSlopes
"for a collection of floats. computes the natural cubic curve fit
and
outputs a collection of cubic polynomials. This is a direct
squeak
transliteration of the java code below."
"The java code is from the net tutorial on splines that I found
recently.
Not my original work. need tofind right attirbution."
"
public class NatCubic extends ControlCurve{
/* calculates the natural cubic spline that interpolates
y[0], y[1], ... y[n]
The first segment is returned as
C[0].a + C[0].b*u + C[0].c*u^2 + C[0].d*u^3 0<=u <1
the other segments are in C[1], C[2], ... C[n-1] */
Cubic[] calcNaturalCubic(int n, int[] x) {
float[] gamma = new float[n+1];
float[] delta = new float[n+1];
float[] D = new float[n+1];
int i;
/* We solve the equation
[2 1 ] [D[0]] [3(x[1] - x[0]) ]
|1 4 1 | |D[1]| |3(x[2] - x[0]) |
| 1 4 1 | | . | = | . |
| ..... | | . | | . |
| 1 4 1| | . | |3(x[n] - x[n-2])|
[ 1 2] [D[n]] [3(x[n] - x[n-1])]
by using row operations to convert the matrix to upper
triangular
and then back sustitution. The D[i] are the derivatives at the
knots.
*/
gamma[0] = 1.0f/2.0f;
for ( i = 1; i < n; i++) {
gamma[i] = 1/(4-gamma[i-1]);
}
gamma[n] = 1/(2-gamma[n-1]);
delta[0] = 3*(x[1]-x[0])*gamma[0];
for ( i = 1; i < n; i++) {
delta[i] = (3*(x[i+1]-x[i-1])-delta[i-1])*gamma[i];
}
delta[n] = (3*(x[n]-x[n-1])-delta[n-1])*gamma[n];
D[n] = delta[n];
for ( i = n-1; i >= 0; i--) {
D[i] = delta[i] - gamma[i]*D[i+1];
}
/* now compute the coefficients of the cubics */
Cubic[] C = new Cubic[n];
for ( i = 0; i < n; i++) {
C[i] = new Cubic((float)x[i], D[i], 3*(x[i+1] - x[i]) - 2*D[i] -
D[i+1],
2*(x[i] - x[i+1]) + D[i] + D[i+1]);
}
return C;
}
final int STEPS = 12;
/* draw a cubic spline */
public void paint(Graphics g){
super.paint(g);
if (pts.npoints >= 2) {
Cubic[] X = calcNaturalCubic(pts.npoints-1, pts.xpoints);
Cubic[] Y = calcNaturalCubic(pts.npoints-1, pts.ypoints);
/* very crude technique - just break each segment up into
steps lines */
Polygon p = new Polygon();
p.addPoint((int) Math.round(X[0].eval(0)),
(int) Math.round(Y[0].eval(0)));
for (int i = 0; i < X.length; i++) {
for (int j = 1; j <= STEPS; j++) {
float u = j / (float) STEPS;
p.addPoint(Math.round(X[i].eval(u)),
Math.round(Y[i].eval(u)));
}
}
g.drawPolyline(p.xpoints, p.ypoints, p.npoints);
}
}
}
"
"Translation note: indexes in java start at 0 in squeak at 1. So
java squeak
0 1 first index
n n1 last index
n+1 n1 size
"
| x gamma delta D n1 |
n1 := self size.
n1 < 3
ifTrue: [self error: 'Less than 3 points makes a poor curve'].
x := self.
gamma := Array new: n1.
delta := Array new: n1.
"C := Array new: n1."
D := Array new: n1.
gamma at: 1 put: 1.0 / 2.0.
(2 to: n1 - 1)
do: [:i | gamma at: i put: 1.0 / (4.0
- (gamma at: i - 1))].
gamma at: n1 put: 1.0 / (2.0
- (gamma at: n1 - 1)).
delta at: 1 put: 3.0 * ((x at: 2)
- (x at: 1))
* (gamma at: 1).
(2 to: n1 - 1)
do: [:i | delta at: i put: 3.0 * ((x at: i + 1)
- (x at: i - 1))
- (delta at: i - 1)
* (gamma at: i)].
delta at: n1 put: 3.0 * ((x at: n1)
- (x at: n1 - 1))
- (delta at: n1 - 1)
* (gamma at: n1).
D
at: n1
put: (delta at: n1).
(1 to: n1 - 1)
reverseDo: [:i | D at: i put: (delta at: i)
- ((gamma at: i)
* (D at: i + 1))].
"debug. Get a snapshot by arming oneshot."
"
self
doOnlyOnce: [({'gamma'} , gamma) explore.
({'delta'} , delta) explore.
({'D'} , D) explore].
"
^ D"
(1 to: n1 - 1)
do: [:i | C at: i put: {x at: i. D at: i. 3 * ((x at: i + 1)
- (x at: i)) - (2
* (D at: i))
- (D at: i + 1). 2 * ((x at: i)
- (x at: i + 1))
+ (D at: i)
+ (D at: i + 1)}].
C at: n1 put: {x at: n1. D at: n1. 0.0. (D at: n1) negated}.
^ C"! !
!SequenceableCollection methodsFor: '*newCurves-cubic support' stamp: 'wiz 5/2/2004 22:43'!
segmentedSlopes
"For a collection of floats. Returns the slopes for straight
segments between vertices."
"last slope closes the polygon. Always return same size as
self. "
^ self
collectWithIndex: [:x :i | (self atWrap: i + 1)
- x]! !
!SequenceableCollection methodsFor: '*newCurves-cubic support' stamp: 'wiz 6/22/2004 15:25'!
unscaledClosedCubicSlopeAt: index using: weights
"returns unscaled slope at index"
"Weights is an array of integers to scale the contributions of the
pairs to the slope."
"The scale is the reciprocal of the next integer in the series times
3. For closed cubic splines the series is the same for all even
or
for all odd vertices.
This routine allows those to be cached."
| foldedSize |
^ ((1 to: (foldedSize := self size - 1 // 2))
collect: [:i | (self atWrap: index - i)
- (self atWrap: index + i)
* (weights at: foldedSize + 1 - i)]) sum! !
!SequenceableCollection methodsFor: '*newCurves-cubic support' stamp: 'wiz 5/27/2004 23:50'!
unscaledSlopesAt: index with: middleSlope nextTo: nextSlope atScale: scale
"Return unscaled slopes for all knots on curve. Calculating
from knots
and two consecutive slopes."
"From the eq b0+4b1+b2= (a2-a1)*3. The factor of 3 has been
left out of this routine for simplicity.
To scale the slopes properly they must be multiplied by 3 * the
reciprocal of scale.
This is done so integer points can be handled by integer
arithmetic until the last instant."
| fullSize results |
(fullSize := self size) < 3
ifTrue: [self error: 'Array to small.'].
"fullSize < index
ifTrue: [self inform: 'Warning!! index out of range']."
results := self species new: fullSize.
"withAll: 0"
results at: index put: middleSlope.
results atWrap: index + 1 put: nextSlope.
(index + 2 to: index + fullSize - 1)
do: [:i | results atWrap: i put: (results atWrap: i - 1)
* 4 negated
- (results atWrap: i - 2) + ((self atWrap: i)
- (self atWrap: i - 2) * scale)].
^ results! !
!SequenceableCollection methodsFor: '*newCurves-cubic support' stamp: 'wiz 4/17/2004 18:44'!
wizPolynomialEval: thisX
"This is a simplification of polynomialEval"
"Treat myself as the coeficients of a polynomial in X. Evaluate it with
thisX. First element is the constant and last is the coeficient for the
highest power."
"#(1 2 3) polynomialEval: 2"
"#(1 2 3) wizPolynomialEval: 2"
"is 3*X^2 + 2*X + 1 with X = 2"
| sum |
sum := 0.
self
reverseDo: [:term | sum := sum * thisX
+ term].
^ sum! !
!SequenceableCollection methodsFor: 'converting-fliprotate' stamp: 'wiz 4/7/2004 09:31'!
flipRotated: flipIndex
"Answer a copy of the receiver with element order indicated by
flipIndex."
"Examples:"
"'frog' flipRotated: 1"
"[ :c | (1 to: c size * 2) collect:
[ :i | c flipRotated: i ]
] value: 'frog'."
"Lsb of flipIndex indicates whether list is reversed"
"The flipIndex // 2 gives how much to rotate by after reversing"
"A good way to think of this is a piece of pie in a pie plate being flip
over its leading edge successively."
"flipIndex > 2 * n are allowed to make it possible to store an array of
indexes in an integer."
| n result src twist |
n := self size.
flipIndex \\ (n * 2) = 0
ifTrue: [^ self].
"allow for doing nothing"
result := self species new: n.
twist := flipIndex // 2 \\ n.
src := 0.
(flipIndex even
ifTrue: [1 + twist to: n + twist]
ifFalse: [n - 1 - twist to: twist negated by: -1])
do: [:i | result
at: (src := src + 1)
put: (self atWrap: i)].
^ result! !
!Cubic methodsFor: '*newCurves-cubic support' stamp: 'wiz 6/17/2004 22:32'!
bestSegments
"Return the smallest integer number of segments that give the
best curve."
^ self honeIn: self calcEnoughSegments! !
!Cubic methodsFor: '*newCurves-cubic support' stamp: 'wiz 6/18/2004 23:12'!
calcEnoughSegments
"Find the power of two that represents a sufficient number of
segments for this cubic.
The measure is the sum of distances for the segments.
We want this to be close enough not affect the straightness of
the drawn lines. Which means within one pixel."
"^ self
enough: 2
withMeasure: (self measureFor: 1)
withIn: self leeway
This ran into a problem when the curve was an s-curve with
inflections. Besides honeIn will check to see if 1 is better than
two so we lose nothing by starting a little higher."
^ self
enough: 4
withMeasure: (self measureFor: 2)
withIn: self leeway! !
!Cubic methodsFor: '*newCurves-cubic support' stamp: 'wiz 7/18/2004 22:50'!
enough: nTry withMeasure: lastMeasure withIn: closeEnough
"See comment in calcEnoughSegments for which I am a helper"
| measure |
measure := self measureFor: nTry.
measure > (lastMeasure + closeEnough)
ifFalse: [^ nTry // 2].
^ self
enough: 2 * nTry
withMeasure: measure
withIn: closeEnough! !
!Cubic methodsFor: '*newCurves-cubic support' stamp: 'wiz 6/17/2004 23:51'!
honeIn: enough
"Find if there is a smaller n than enough that give the same
measure for n."
self
assert: [enough isPowerOfTwo].
enough < 2
ifTrue: [^ enough].
^ self
honeIn: enough
step: enough // 2
measure: (self measureFor: enough)
withIn: self leeway! !
!Cubic methodsFor: '*newCurves-cubic support' stamp: 'wiz 6/17/2004 23:45'!
honeIn: centerN step: step measure: measure withIn: closeEnough
"Pick the best n by binary search."
| nTry |
step < 1
ifTrue: [^ centerN].
nTry := centerN - step.
^ measure > (closeEnough
+ (self measureFor: nTry))
ifTrue: [self
honeIn: centerN
step: step // 2
measure: measure
withIn: closeEnough]
ifFalse: [self
honeIn: nTry
step: step // 2
measure: measure
withIn: closeEnough]! !
!Cubic methodsFor: '*newCurves-cubic support' stamp: 'wiz 6/19/2004 00:00'!
leeway
"How close can measure be"
^ 0.1! !
!Cubic methodsFor: '*newCurves-cubic support' stamp: 'wiz 7/7/2004 01:36'!
measureFor: n
"Return a distance measure for cubic curve with n segments.
For convienence and accuracy we use the sum or the distances."
"first point is poly of 0."
| p1 p2 measure |
p1 := self first.
measure := 0.
(1 to: n)
do: [:i |
p2 := self wizPolynomialEval: i / n asFloat.
measure := measure
+ (p2 dist: p1).
p1 := p2].
^ measure! !
CurvierMorph initialize!
!Integer reorganize!
('testing' even isInteger isPowerOfTwo)
('arithmetic' * + - / // \\\ alignedTo: quo:)
('comparing' < = > hash)
('truncation and round off' asLargerPowerOfTwo asPowerOfTwo asSmallerPowerOfTwo atRandom atRandom: ceiling floor normalize rounded truncated)
('enumerating' timesRepeat:)
('mathematical functions' factorial gcd: lcm: raisedTo:modulo: take:)
('bit manipulation' << >> allMask: anyBitOfMagnitudeFrom:to: anyMask: bitAnd: bitClear: bitInvert bitInvert32 bitOr: bitShift: bitShiftMagnitude: bitXor: highBit highBitOfMagnitude lowBit noMask:)
('converting' adaptToComplex:andSend: adaptToFraction:andSend: adaptToScaledDecimal:andSend: asCharacter asColorOfDepth: asComplex asFloat asFraction asHexDigit asInteger asScaledDecimal: asYear)
('printing' asStringWithCommas asStringWithCommasSigned asTwoCharacterString asWords byteEncode:base: destinationBuffer: digitBuffer: hex hex8 isLiteral printOn:base: printOn:base:showRadix: printPaddedWith:to: printPaddedWith:to:base: printStringRadix: radix: romanString)
('system primitives' lastDigit replaceFrom:to:with:startingAt:)
('private' copyto: digitAdd: digitCompare: digitDiv:neg: digitLogic:op:length: digitLshift: digitMultiply:neg: digitRshift:bytes:lookfirst: digitSubtract: growby: growto: print:on:prefix:length:padded: romanDigits:for:on:)
('benchmarks' benchFib benchmark tinyBenchmarks)
('tiles' asPrecedenceName)
('spline support')
('*newCurve-support' cacheForClosedCubicSolution)
('printing-numerative' printOn:base:length:padded: printStringBase: printStringBase:length:padded: printStringHex printStringLength: printStringLength:padded: printStringPadded: printStringRoman storeOn:base: storeOn:base:length:padded: storeStringBase:length:padded: storeStringHex)
!
"Postscript:
Do class initialzation to enable new curve behavior and update objects catalog."
CurvierMorph initialize .
"Need to do something here to update supplies flap but what used to work went away."
!