'From Squeak3.9alpha of 4 July 2005 [latest update: #7001] on 23 February 2006 at 2:28:05 am'!
"Change Set: MixedCurveAft7001-wiz
Date: 23 February 2006
Author: (wiz) Jerome Peace
wiz 2/23/2006 02:25
MixedCurve additions to Curvier stuff.
Left out the roundoff fixes which are now in another cs.
The theory behind this is to have something that loads w/o territorial desputes. Or changes in class organization for point and rectangle which seems to cause MC to have fits."!
PolygonMorph subclass: #MixedCurveMorph
instanceVariableNames: 'slopeClamps'
classVariableNames: ''
poolDictionaries: ''
category: 'Morphic-Basic-NewCurve'!
!MixedCurveMorph commentStamp: '' prior: 0!
A MixedCurveMorph is Curve that can be broken up into separately curved segments. It allows for the creation of matching edges( e. g. for jigsaw puzzle pieces).
Instance Variables
slopeClamps:
slopeClamps
- elements of array are either 0 or nil. Indicating whether slope for the corresponding vertex is 0@0 or unknown and therefore to be calculated. There is one element for each vertex.
!
!PolygonMorph methodsFor: 'editing' stamp: 'wiz 2/8/2006 19:02'!
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: (self handleColorAt: vertIndex) .
handle
on: #mouseMove
send: #dragVertex:event:fromHandle:
to: self
withValue: vertIndex.
handle
on: #mouseUp
send: #dropVertex:event:fromHandle:
to: self
withValue: vertIndex.
handle
on: #click
send: #clickVertex: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! !
!PolygonMorph methodsFor: 'editing' stamp: 'wiz 2/7/2006 23:35'!
clickVertex: ix event: evt fromHandle: handle
"Backstop for MixedCurveMorph"! !
!PolygonMorph methodsFor: 'editing' stamp: 'wiz 2/8/2006 18:20'!
deleteVertexAt: anIndex
"This acts as a backstop for MixedCurveMorph."
self
setVertices: (vertices
copyReplaceFrom: anIndex
to: anIndex
with: Array new).
! !
!PolygonMorph methodsFor: 'editing' stamp: 'wiz 2/8/2006 18:35'!
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 deleteVertexAt: ix .].
evt shiftPressed
ifTrue: [self removeHandles]
ifFalse: [self addHandles
"remove then add to recreate"]! !
!PolygonMorph methodsFor: 'editing' stamp: 'wiz 2/8/2006 18:37'!
handleColorAt: vertIndex
"This is a backstop for MixedCurveMorph"
^ Color yellow
! !
!PolygonMorph methodsFor: 'editing' stamp: 'wiz 2/8/2006 18:19'!
insertVertexAt: anIndex put: aValue
"This serves as a hook and a backstop for MixedCurveMorph."
self setVertices: (vertices copyReplaceFrom: anIndex + 1 to: anIndex
with: (Array with: aValue)).! !
!PolygonMorph methodsFor: 'editing' stamp: 'wiz 2/8/2006 18:25'!
newVertex: ix event: evt fromHandle: handle
"Insert a new vertex and fix everything up!! Install the drag-handle of the new vertex as recipient of further mouse events."
| pt |
"(self hasProperty: #noNewVertices) ifFalse:
[pt _ evt cursorPoint.
self setVertices: (vertices copyReplaceFrom: ix + 1 to: ix with: (Array with: pt)).
evt hand newMouseFocus: (handles at: ((ix + 1) * 2) - 1)]"
"modified to remove now vestigial test. see PolygonMorph class>>arrowprototype"
pt _ evt cursorPoint.
self insertVertexAt: ix put: pt .
evt hand newMouseFocus: (handles at: ((ix + 1) * 2) - 1)! !
!MixedCurveMorph methodsFor: 'editing' stamp: 'wiz 2/8/2006 17:50'!
clickVertex: ix event: evt fromHandle: handle
" Toggle the state of the clamp. "
"Note: self clamps assures slopeClamps will be same size as vertices"
(self clamps at: ix)
ifNil: [ slopeClamps at: ix put: 0 ]
ifNotNil: [ slopeClamps at: ix put: nil ] .
self setVertices: vertices .
! !
!MixedCurveMorph methodsFor: 'editing' stamp: 'wiz 2/8/2006 18:01'!
deleteVertexAt: anIndex
(slopeClamps :=
slopeClamps
copyReplaceFrom: anIndex
to: anIndex
with: Array new) .
self
setVertices: (vertices
copyReplaceFrom: anIndex
to: anIndex
with: Array new).
! !
!MixedCurveMorph methodsFor: 'editing' stamp: 'wiz 2/8/2006 18:29'!
insertVertexAt: anIndex put: aValue
"New vertexs are unclamped."
"Note: order is important.
The clamps array must match vertex size before setVertices: is performed."
slopeClamps := slopeClamps
copyReplaceFrom: anIndex + 1 to: anIndex with: (Array with: nil).
self setVertices: (vertices copyReplaceFrom: anIndex + 1 to: anIndex
with: (Array with: aValue)).! !
!MixedCurveMorph methodsFor: 'smoothing' stamp: 'wiz 2/18/2006 12:53'!
slopes: knots
"Choose slopes according to state of polygon and preferences"
self isCurvy
ifFalse: [^ knots segmentedSlopes].
^ (closed
and: [self isCurvier])
ifTrue: [ knots closedCubicSlopes: self clamps ]
ifFalse: [knots naturalCubicSlopes: self clamps ]! !
!MixedCurveMorph methodsFor: 'access' stamp: 'wiz 2/8/2006 18:59'!
clamps
" Return a collection of clamps the same size as vertices.
If necessary default to unclamped slopes.
"
slopeClamps
ifNil: [ ^ slopeClamps := Array new: vertices size ] .
slopeClamps size = vertices size
ifFalse: [ ^ slopeClamps := Array new: vertices size ] .
^ slopeClamps ! !
!MixedCurveMorph methodsFor: 'access' stamp: 'wiz 2/8/2006 17:44'!
handleColorAt: vertIndex
" clamped handles are cyan and
unclamped handles are yellow."
(self clamps at: vertIndex ) ifNil: [ ^ Color yellow ] .
^ Color cyan
! !
!MixedCurveMorph methodsFor: 'initialization' stamp: 'wiz 2/12/2006 05:59'!
initialize
"initialize the state of the receiver"
super initialize.
self extent: 32@20 .
self rectOval.
self clamps . "This initializes slopeClamps."
slopeClamps at: 1 put: 0 .
slopeClamps at: 4 put: 0 .
closed _ true.
smoothCurve _ true.
arrows _ #none.
self computeBounds! !
!MixedCurveMorph class methodsFor: 'as yet unclassified' stamp: 'wiz 2/12/2006 17:12'!
descriptionForPartsBin
^ self partName: 'Mixed'
categories: #('Graphics' 'Basic')
documentation: 'A Curve with optional bends and segments. Shift click to get handles.
Click handles to change bends. Move handles to move the points.'! !
!SequenceableCollection methodsFor: '*Morphic-NewCurves-cubic support' stamp: 'wiz 2/18/2006 12:57'!
assertSlopesWith: knots from: start to: end
"
We trust everything has been checked.
The following assertions should hold at this point: "
| slope |
self assert: [ self size = knots size ] .
"Sizes must be consistent."
self assert: [ end > start].
"There must be at least one slope to clamp."
self assert: [ 0 < start and: [start <= knots size] ].
"The clamped slope may be the last one."
self assert: [ end <= knots size + start ] .
"We can wrap. There may be only one known slope."
"xxx self assert: [ end = knots size + start ifTrue: [ (self at: start) notNil ] ] . xxx"
"xxx If we overlap slope must be known. xxx"
{ start . end }
do: [ :index | slope := (self at: index )
self assert: [ slope isNil
or: [ slope isNumber
or: [ slope isPoint ] ] ] ] .
"And a known and reasonalble value or nil."
^true
! !
!SequenceableCollection methodsFor: '*Morphic-NewCurves-cubic support' stamp: 'wiz 2/18/2006 12:54'!
closedCubicSlopes: clampedSlopes
"Sent to knots returns a copy of clampedSlopes with the values of the undefined (nil) slopes filled in.
"
" clampedSlopes must be the same size as knots)"
"/* Between known slopes we solve the equation for knots with end conditions:
4*b1+b2 = 3(a2 - a0) - b0
bN2+4*bN1 = 3*(aN-aN2) - bN
and inbetween:
b2+4*b3+b4=3*(a4-a2)
where a2 is (knots atWrap: index + 1) etc.
and the b's are the slopes .
N is the last index (knots size)
N1 is N-1.
by using row operations to convert the matrix to upper
triangular and then back substitution.
"
| slopes tripleKnots list |
(list := clampedSlopes closedFillinList) = { 0 to: self size } ifTrue: [ ^ self closedCubicSlopes ] .
"Special case all unknown."
tripleKnots := self * 3.0 .
" Premultiply and convert numbers or point coords to Floats "
slopes := clampedSlopes copy. "slopes contents will be modified."
list do: [ :r | slopes slopesWith: tripleKnots from: r first to: r last ] .
^ slopes! !
!SequenceableCollection methodsFor: '*Morphic-NewCurves-cubic support' stamp: 'wiz 2/17/2006 01:42'!
closedFillinList
"Answers a list of ranges between which values are undertermined.
Reciever is a list that combines known values and nil entries for
undetermined values.
Answer a list of ranges. Each range starts and ends with a known
value.
The range inbetween the known values are nil. The ranges start and
ends may overlap.
Each nil element in the list appears in exactly one range.
If the list starts or ends with nil the last range will wrap around to the
next known value. There may be only one known value in the list but
there must be atleast one know value.
(self allsatisfy: [ :e | e isNil ] ) ifTrue: [ self error: 'list must contain at
least one known value' ]
"
| changes n |
changes := self nilTransitions .
changes isEmpty ifTrue: [ ^ { 0 to: self size } "Special case. All unknowns." ] .
changes = #(1) ifTrue: [ ^ #() "Special case. no unknowns." ] .
changes = { n := self size } ifTrue: [ ^ { n to: n + n } ] .
"Special case. Only last element known."
changes size even ifTrue:
[changes add: self size
+ (changes at: 1)]
ifFalse: [
changes first = 1 ifFalse: [ changes add: self size + 1;
add: self size + changes first ]
].
^ changes allButFirst pairsCollect: [ :s :e | ( s - 1 to: e ) ] .
! !
!SequenceableCollection methodsFor: '*Morphic-NewCurves-cubic support' stamp: 'wiz 2/12/2006 23:21'!
naturalCubicSlopes
"Sent to knots returns the slopes of a natural cubic curve fit.
This is a direct squeak
transliteration of the java code."
" public class NatCubic extends ControlCurve
/* We solve the equation for knots with end conditions:
2*b1+b2 = 3(a1 - a0)
bN1+2*bN = 3*(aN-aN1)
and inbetween:
b2+4*b3+b4=3*(a4-a2)
where a2 is (knots atWrap: index + 1) etc.
and the b's are the slopes .
N is the last index (knots size)
N1 is 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.
"
| 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.
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))].
^ D! !
!SequenceableCollection methodsFor: '*Morphic-NewCurves-cubic support' stamp: 'wiz 2/18/2006 12:55'!
naturalCubicSlopes: clampedSlopes
"Sent to knots returns a copy of clampedSlopes with the values of the undefined (nil) slopes filled in.
"
" clampedSlopes must be the same size as knots)"
"/* Between known slopes we solve the equation for knots with end conditions:
4*b1+b2 = 3(a2 - a0) - b0
bN2+4*bN1 = 3*(aN-aN2) - bN
and inbetween:
b2+4*b3+b4=3*(a4-a2)
where a2 is (knots atWrap: index + 1) etc.
and the b's are the slopes .
N is the last index (knots size)
N1 is N-1.
by using row operations to convert the matrix to upper
triangular and then back substitution.
"
| slopes tripleKnots |
tripleKnots := self * 3.0 .
" Premultiply and convert numbers or point coords to Floats "
slopes := clampedSlopes copy. "slopes will be modified."
clampedSlopes naturalFillinList do: [ :r | slopes slopesWith: tripleKnots from: r first to: r last ] .
^ slopes! !
!SequenceableCollection methodsFor: '*Morphic-NewCurves-cubic support' stamp: 'wiz 2/9/2006 00:46'!
naturalFillinList
"Return a list of fillin ranges to be used to calculate natural or clamped slopes.
Note that this list is slightly different in mission from the closedFillinList"
"Answers a list of ranges between which value are undertermined.
Reciever is a list that combines known values and nil entries for
undetermined values.
Answer a list of ranges. Each range starts and ends with a known value.
With the exception of the first and last slopes on the list which may be unknown.
If no slopes are known then the only range is the whole list.
If all slopes are known then the fillin list is empty.
The range inbetween the known values are nil. The ranges start and
ends may overlap if the slope at the overlap is known.
Each nil element in the list appears in exactly one range.
"
| changes |
changes := self nilTransitions .
changes isEmpty ifTrue: [ ^ { 1 to: self size } "Special case all unknown." ] .
changes = #(1) ifTrue: [ ^ #() "Special case. no unknowns." ] .
changes size even
ifTrue: [changes add: self size ] . "Last slope is unknown"
changes first = 1
ifTrue: [ ^ changes allButFirst pairsCollect: [ :s :e | ( s - 1 to: e ) ] ] .
"Otherwise first slope is unknown."
^ { 1 to: changes first } ,
(changes allButFirst pairsCollect: [ :s :e | ( ( s - 1) to: e ) ])
! !
!SequenceableCollection methodsFor: '*Morphic-NewCurves-cubic support' stamp: 'wiz 1/29/2006 20:51'!
nilTransitions
"Return an OrderedCollection of transition indexes.
Indexes represent where the list elements transitions
from nil to nonNil
or from nonNil to nil.
1 is an index in the list iff the first element is nonNil. "
| changes nilSkip |
changes := OrderedCollection new.
nilSkip := true .
(1 to: self size)
do: [:i | (self atWrap: i) isNil == nilSkip
ifFalse: [changes add: i.
nilSkip := nilSkip not]].
^ changes ! !
!SequenceableCollection methodsFor: '*Morphic-NewCurves-cubic support' stamp: 'wiz 2/18/2006 12:54'!
slopesWith: tripleKnots from: start to: end
"Sent to modifiable list of slopes. Fills in the slope values between start
and end. Start and end slopes can be either clamped or nil.
If nil the natural slope for that value will be filled in.
We expect that the parameters meets the assertions in
self assertSlopesWith: knots from: start to: end."
"
/* We solve the equation for knots with end conditions either known or unknown:
4*b1+b2 = 3*(a2 - a0) - b0 b0 known
Or
2*b0+b1 = 3*(a1 - a0) . b0 == nil
bN2+4*bN1 = 3*(aN-aN2)-bN bN known
Or
bN1+2*bN = 3*(aN-aN1) bN == nil
.
b0, bN are starting and ending slopes.
We now handle the special closed cubic case where a0 == aN ( i.e. N = knots size )
and b0 == bN == nil .
and inbetween:
b2+4*b3+b4=3*(a4-a2)
where a2 is (knots atWrap: index + 1) etc.
and the b's are the slopes .
by using row operations to convert the matrix to upper
triangular and then back substitution.
"
| gamma delta n range isOpenRange |
n := self size.
gamma := Array new: n.
delta := Array new: n.
isOpenRange := end < (start + self size) .
(self at: start)
ifNotNil: [
gamma at: start put: 0.0.
delta
at: start
put: (self at: start).
range := ( start + 1 to: end - 1 ) .
] " clamped initial conditions"
ifNil: [
isOpenRange
ifTrue:
[gamma at: start put: 2.0 reciprocal.
delta
at: start
put: ((tripleKnots atWrap: start + 1)
- tripleKnots at: start ) * (gamma at: start) .
range := ( start to: end - 1 ) . ] "natural initial conditions "
ifFalse:
[ gamma at: start put: 4.0 reciprocal.
delta
at: start
put: ((tripleKnots atWrap: start + 1)
- tripleKnots atWrap: start - 1 ) * (gamma at: start) .
range := ( start + 1 to: end - 1 ) .
] "closed initial conditions "
] .
(start + 1 to: end - 1)
do: [:i | gamma atWrap: i put: 1.0 / (4.0
- (gamma atWrap: i - 1))].
(start + 1 to: end - 1)
do: [:i | delta atWrap: i put: ((tripleKnots atWrap: i + 1)
- (tripleKnots atWrap: i - 1))
- (delta atWrap: i - 1)
* (gamma atWrap: i)].
(self atWrap: end)
ifNil: [ isOpenRange
ifTrue: [
gamma atWrap: end put: 1.0 / (2.0
- (gamma atWrap: end - 1 )).
delta
atWrap: end
put: ((tripleKnots atWrap: end )
- tripleKnots atWrap: end - 1 )
- (delta at: end - 1 ) * (gamma atWrap: end)] "natural end conditions"
ifFalse: [
gamma atWrap: end put: 1.0 / (4.0
- (gamma atWrap: end - 1 )).
delta
atWrap: end
put: ((tripleKnots atWrap: end + 1 )
- tripleKnots atWrap: end - 1 )
- (delta at: end - 1 ) * (gamma atWrap: end)] "closed end conditions"
.
self atWrap: end put: (delta atWrap: end ) .
]
ifNotNil: [
gamma atWrap: end put: 0.0 .
delta
atWrap: end
put: (self atWrap: end) .
] "clamped end conditions" .
range
reverseDo: [:i | self atWrap: i put:
(delta atWrap: i)
- ((gamma atWrap: i)
* (self atWrap: i + 1)) ] .
" reciever now contains the filled in slopes."
^ self ! !
!SequenceableCollection methodsFor: '*Morphic-NewCurves-cubic support' stamp: 'wiz 2/16/2006 20:08'!
transitions
"Sent to a list of boolean values.
Return an OrderedCollection of transition indexes.
Indexes represent where the list elements transitions
from true to false
or from false to true.
1 is an index in the list iff the first element is false. "
| changes boolSkip |
changes := OrderedCollection new.
boolSkip := true .
self
withIndexDo: [:truth :i | truth == boolSkip
ifFalse: [changes add: i.
boolSkip := boolSkip not]].
^ changes ! !
!SequenceableCollection methodsFor: '*Morphic-NewCurves-cubic support' stamp: 'wiz 2/16/2006 20:09'!
transitions: aSelectBlock
"Sent to a list. Select block returns a boolean
Return an OrderedCollection of transition indexes.
Indexes represent where the list elements transitions
from true to false
or from false to true.
1 is an index in the list iff the first element tests false. "
| changes boolSkip |
changes := OrderedCollection new.
boolSkip := true .
self withIndexDo:
[:e :i | (aSelectBlock value: e ) == boolSkip
ifFalse: [changes add: i.
boolSkip := boolSkip not]].
^ changes ! !