[squeak-dev] Triangulation was: Re: (no subject)

David T. Lewis lewis at mail.msen.com
Fri Jan 25 02:24:33 UTC 2019


Herbert,

Thanks for finding the background on this.

The classes Subdivision, SubdivisionHalfEdge, and SubdivisionQuadEdge are
present in Squeak 3.2, but not in Squeak 2.8. Some of the methods have no
author initials, so they date back to the early days of Squeak. All of the
methods with timestamps are from 'ar' so I think that Andreas Raab wrote
the package.

I see no direct references to these classes in the 2.8 image, and my guess
would be that they were probably removed at some later point because they
were not needed in the base image.

Given that the classes were written by Andreas, I think that it is safe
to say that they will be of high quality, and that they will work with
little or no change in the latest Squeak trunk images.

The classes are in category 'Graphics-Tools-Triangulation', so if you
file that out from Squeak 3.8 and load it back in to your current Squeak
image, it will work.

I just tried this in my trunk image, and the class side examples in
Subdivision work fine, with no modifications required at all.

I am attaching the fileout from Squeak 3.8.

Good stuff, thanks for finding it :-)

Dave

On Thu, Jan 24, 2019 at 09:58:42PM +0100, Herbert K??nig wrote:
> Hi Ralph,
> 
> in Squeak 3.6 and 3.8 there is class Subdivision with the comment:
> 
> "I perform (constraint) delauney triangulations on a set of points. See 
> my class side for examples."
> 
> I know I once used it I guess in 3.6 but can't find that image anymore.
> 
> Cheers,
> 
> 
> Herbert
> 
> 
> Am 24.01.2019 um 19:19 schrieb Ralph Boland:
> >
> >code in the workbench too (I need to be able to triangulate a polygon).
> 
> 
> 
> >It would also be cool to see the workbench ported to Squeak.
> >I would be willing to help with such a port but only as a minor 
> >contributer as
> >I already have enough on my plate.
> >
> >Ralph Boland
> >
> 
-------------- next part --------------
Object subclass: #Subdivision
	instanceVariableNames: 'area startingEdge point1 point2 point3 stamp outlineThreshold'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Tools-Triangulation'!
!Subdivision commentStamp: '<historical>' prior: 0!
I perform (constraint) delauney triangulations on a set of points. See my class side for examples.!


!Subdivision methodsFor: 'constraints' stamp: 'ar 5/19/2001 13:42'!
assureEdgeFrom: lastPt to: nextPt lastEdge: lastEdge
	"Find and return the edge connecting nextPt and lastPt.
	lastEdge starts at lastPt so we can simply run around all
	the edges at lastPt and find one that ends in nextPt.
	If none is found, subdivide between lastPt and nextPt."
	| nextEdge destPt |
	nextEdge _ lastEdge.
	[destPt _ nextEdge destination.
	destPt x = nextPt x and:[destPt y = nextPt y]] whileFalse:[
		nextEdge _ nextEdge originNext.
		nextEdge = lastEdge ifTrue:[
			"Edge not found. Subdivide and start over"
			nextEdge _ self insertEdgeFrom: lastPt to: nextPt lastEdge: lastEdge.
			nextEdge ifNil:[^nil].
		].
	].
	nextEdge isBorderEdge: true.
	^nextEdge
! !

!Subdivision methodsFor: 'constraints' stamp: 'ar 3/7/2003 14:20'!
assureEdgeFrom: lastPt to: nextPt lastEdge: lastEdge into: outPoints
	"Find and return the edge connecting nextPt and lastPt.
	lastEdge starts at lastPt so we can simply run around all
	the edges at lastPt and find one that ends in nextPt.
	If none is found, subdivide between lastPt and nextPt."
	| nextEdge destPt |
	nextEdge _ lastEdge.
	[destPt _ nextEdge destination.
	destPt x = nextPt x and:[destPt y = nextPt y]] whileFalse:[
		nextEdge _ nextEdge originNext.
		nextEdge = lastEdge ifTrue:[
			"Edge not found. Subdivide and start over"
			nextEdge _ self insertEdgeFrom: lastPt to: nextPt lastEdge: lastEdge into: outPoints.
			nextEdge ifNil:[^nil].
		].
	].
	nextEdge isBorderEdge: true.
	^nextEdge
! !

!Subdivision methodsFor: 'constraints' stamp: 'ar 3/7/2003 14:21'!
constraintOutline: pointList
	"Make sure all line segments in the given closed outline appear in the triangulation."
	| lastPt nextPt lastEdge nextEdge outPoints |
	outlineThreshold ifNil:[outlineThreshold _ 1.0e-3].
	lastPt _ pointList last.
	lastEdge _ self locatePoint: lastPt.
	lastEdge origin = lastPt 
		ifFalse:[lastEdge _ lastEdge symmetric].
	outPoints := WriteStream on: (Array new: pointList size).
	1 to: pointList size do:[:i|
		nextPt _ pointList at: i.
		lastPt = nextPt ifFalse:[
			nextEdge _ self assureEdgeFrom: lastPt to: nextPt lastEdge: lastEdge into: outPoints.
			outPoints nextPut: nextPt.
			nextEdge ifNil:[
				nextEdge _ self locatePoint: nextPt.
				lastEdge destination = nextPt 
					ifFalse:[lastEdge _ lastEdge symmetric].
			].
			lastEdge _ nextEdge symmetric originNext].
		lastPt _ nextPt.
	].
	^outPoints contents! !

!Subdivision methodsFor: 'constraints' stamp: 'ar 3/7/2003 14:29'!
findEdgeFrom: lastPt to: nextPt lastEdge: lastEdge
	"Find and return the edge connecting nextPt and lastPt.
	lastEdge starts at lastPt so we can simply run around all
	the edges at lastPt and find one that ends in nextPt."
	| nextEdge destPt |
	nextEdge _ lastEdge.
	[destPt _ nextEdge destination.
	destPt x = nextPt x and:[destPt y = nextPt y]] whileFalse:[
		nextEdge _ nextEdge originNext.
		nextEdge = lastEdge ifTrue:[^nil].
	].
	^nextEdge! !

!Subdivision methodsFor: 'constraints' stamp: 'ar 3/7/2003 15:07'!
flagExteriorEdgesFrom: lastEdge to: nextEdge direction: thisWay
	| tmpEdge |
	lastEdge isBorderEdge ifFalse:[self error: 'not border'].
	nextEdge isBorderEdge ifFalse:[self error: 'not border'].
	tmpEdge := lastEdge.
	thisWay ifTrue:[
		[tmpEdge := tmpEdge originNext.
		tmpEdge == nextEdge] whileFalse:[
			tmpEdge isBorderEdge ifTrue:[self error: 'border'].
			tmpEdge isExteriorEdge: true.
		].
	] ifFalse:[
		[tmpEdge := tmpEdge originPrev.
		tmpEdge == nextEdge] whileFalse:[
			tmpEdge isBorderEdge ifTrue:[self error: 'border'].
			tmpEdge isExteriorEdge: true.
		].
	].! !

!Subdivision methodsFor: 'constraints' stamp: 'ar 5/19/2001 14:29'!
insertEdgeFrom: lastPt to: nextPt lastEdge: prevEdge
	| midPt lastEdge nextEdge dst |
	dst _ lastPt - nextPt.
	(dst dotProduct: dst) < outlineThreshold ifTrue:[^nil].
	midPt _ lastPt interpolateTo: nextPt at: 0.5.
	self insertPoint: midPt.
	lastEdge _ prevEdge.
	nextEdge _ self assureEdgeFrom: lastPt to: midPt lastEdge: lastEdge.
	nextEdge ifNil:[^nil].
	lastEdge _ nextEdge symmetric originNext.
	nextEdge _ self assureEdgeFrom: midPt to: nextPt lastEdge: lastEdge.
	^nextEdge! !

!Subdivision methodsFor: 'constraints' stamp: 'ar 3/7/2003 14:21'!
insertEdgeFrom: lastPt to: nextPt lastEdge: prevEdge into: outPoints
	| midPt lastEdge nextEdge dst |
	dst _ lastPt - nextPt.
	(dst dotProduct: dst) < outlineThreshold ifTrue:[^nil].
	midPt _ lastPt interpolateTo: nextPt at: 0.5.
	self insertPoint: midPt.
	lastEdge _ prevEdge.
	nextEdge _ self assureEdgeFrom: lastPt to: midPt lastEdge: lastEdge into: outPoints.
	outPoints nextPut: midPt.
	nextEdge ifNil:[^nil].
	lastEdge _ nextEdge symmetric originNext.
	nextEdge _ self assureEdgeFrom: midPt to: nextPt lastEdge: lastEdge into: outPoints.
	^nextEdge! !

!Subdivision methodsFor: 'constraints' stamp: 'ar 5/19/2001 16:21'!
insertSpine
	| ptList start end |
	ptList _ WriteStream on: (Array new: 100).
	self edgesDo:[:e|
		(e isBorderEdge or:[e isExteriorEdge]) ifFalse:[
			start _ e origin.
			end _ e destination.
			ptList nextPut: (start + end * 0.5).
		].
	].
	ptList contents do:[:pt| self insertPoint: pt].! !

!Subdivision methodsFor: 'constraints' stamp: 'ar 5/19/2001 16:16'!
markExteriorEdges
	"Recursively flag all edges that are known to be exterior edges.
	If the outline shape is not simple this may result in marking all edges."
	| firstEdge |
	firstEdge _ self locatePoint: point1.
	firstEdge origin = point1 
		ifFalse:[firstEdge _ firstEdge symmetric].
	firstEdge markExteriorEdges: (stamp _ stamp + 1).! !

!Subdivision methodsFor: 'constraints' stamp: 'ar 3/7/2003 14:48'!
markExteriorEdges: thisWay in: pointList
	"Mark edges as exteriors"
	| lastPt nextPt lastEdge nextEdge |
	lastPt _ pointList last.
	lastEdge _ self locatePoint: lastPt.
	lastEdge origin = lastPt 
		ifFalse:[lastEdge _ lastEdge symmetric].
	nextEdge _ self findEdgeFrom: lastPt to: (pointList atWrap: pointList size-1) lastEdge: lastEdge.
	lastEdge := nextEdge.
	1 to: pointList size do:[:i|
		nextPt _ pointList at: i.
		lastPt = nextPt ifFalse:[
			nextEdge _ self findEdgeFrom: lastPt to: nextPt lastEdge: lastEdge.
			nextEdge ifNil:[
				nextEdge _ self locatePoint: nextPt.
				lastEdge destination = nextPt 
					ifFalse:[lastEdge _ lastEdge symmetric].
			] ifNotNil:[
				self flagExteriorEdgesFrom: lastEdge to: nextEdge direction: thisWay.
			].
			lastEdge _ nextEdge symmetric].
		lastPt _ nextPt.
	].
! !


!Subdivision methodsFor: 'private' stamp: 'ar 5/24/2001 12:47'!
debugDraw
	| scale ofs |
	scale _ 100.
	ofs _ 400.
	self edgesDo:[:e|
		Display getCanvas line: e origin * scale + ofs to: e destination * scale + ofs width: 3 color: e classificationColor].! !

!Subdivision methodsFor: 'private' stamp: 'ar 5/19/2001 13:59'!
edgesDo: aBlock
	startingEdge first edgesDo: aBlock stamp: (stamp _ stamp + 1).! !

!Subdivision methodsFor: 'private' stamp: 'ar 5/19/2001 17:11'!
innerTriangleEdgesDo: aBlock
	startingEdge first triangleEdges: (stamp _ stamp + 1) do:
		[:e1 :e2 :e3|
			self assert:[e1 origin = e3 destination].
			self assert:[e2 origin = e1 destination].
			self assert:[e3 origin = e2 destination].
			(e1 isExteriorEdge or:[e2 isExteriorEdge or:[e3 isExteriorEdge]]) ifFalse:[
				aBlock value: e1 value: e2 value: e3.
			].
		].
! !

!Subdivision methodsFor: 'private' stamp: 'ar 5/19/2001 17:03'!
innerTriangles
	| out |
	out _ WriteStream on: (Array new: 100).
	self innerTriangleVerticesDo:[:p1 :p2 :p3| out nextPut: {p1. p2. p3}].
	^out contents! !

!Subdivision methodsFor: 'private' stamp: 'ar 5/19/2001 17:01'!
innerTriangleVerticesDo: aBlock
	startingEdge first triangleEdges: (stamp _ stamp + 1) do:
		[:e1 :e2 :e3|
			self assert:[e1 origin = e3 destination].
			self assert:[e2 origin = e1 destination].
			self assert:[e3 origin = e2 destination].
			(e1 isExteriorEdge or:[e2 isExteriorEdge or:[e3 isExteriorEdge]]) ifFalse:[
				aBlock value: e1 origin value: e2 origin value: e3 origin.
			].
		].
! !

!Subdivision methodsFor: 'private' stamp: 'ar 5/19/2001 16:47'!
quadEdgeClass
	^SubdivisionQuadEdge! !

!Subdivision methodsFor: 'private' stamp: 'ar 5/19/2001 16:58'!
trianglesDo: aBlock
	"Return the full triangulation of the receiver"
	startingEdge first triangleEdges: (stamp _ stamp + 1) do: aBlock.
! !


!Subdivision methodsFor: 'accessing' stamp: 'ar 5/18/2001 21:58'!
edges
	"Return the triangulation edges"
	| edges |
	edges := IdentitySet new: 500.
	startingEdge first collectQuadEdgesInto:edges.
	"Build line segments"
	edges := edges collect:[:edge | 
				LineSegment from: edge first origin to: edge first destination].
	"Remove the outer triangulation edges"
	^edges select:[:edge|
			area origin <= edge start and:[edge start <= area corner and:[area origin <= edge end and:[edge end <= area corner]]]]! !

!Subdivision methodsFor: 'accessing' stamp: 'ar 5/18/2001 22:10'!
faces
	"Construct and return triangles"
	| firstEdge nextEdge lastEdge |
	firstEdge _ nextEdge _ startingEdge first.
	[lastEdge _ nextEdge.
	nextEdge _ nextEdge originNext.
	nextEdge == firstEdge] whileFalse:[
		"Make up a triangle between lastEdge and nextEdge"
	].
! !

!Subdivision methodsFor: 'accessing' stamp: 'ar 5/19/2001 14:28'!
outlineThreshold
	"Return the current outline threshold.
	The outline threshold determines when to stop recursive
	subdivision of outline edges in the case of non-simple
	(that is self-intersecting) polygons."
	^outlineThreshold! !

!Subdivision methodsFor: 'accessing' stamp: 'ar 5/19/2001 14:28'!
outlineThreshold: aNumber
	"Set the current outline threshold.
	The outline threshold determines when to stop recursive
	subdivision of outline edges in the case of non-simple
	(that is self-intersecting) polygons."
	outlineThreshold _ aNumber! !

!Subdivision methodsFor: 'accessing' stamp: 'ar 5/19/2001 21:52'!
points: pointCollection

	| min max |
	pointCollection isEmpty ifTrue:[
		min := -1.0 at -1.0.
		max := 1.0 at 1.0.
	] ifFalse:[
		min := max := pointCollection anyOne.
		pointCollection do:[:p|
			min := min min: p.
			max := max max: p]].
	self withSize: (min corner: max).
	pointCollection do:[:p| self insertPoint: p].! !

!Subdivision methodsFor: 'accessing' stamp: 'ar 5/18/2001 22:06'!
startingEdge
	^startingEdge! !


!Subdivision methodsFor: 'triangulation' stamp: 'ar 5/19/2001 16:47'!
insertPoint: aPoint
	"Inserts a new point into a subdivision representing a Delaunay
	triangulation, and fixes the affected edges so that the result
	is still a Delaunay triangulation. This is based on the
	pseudocode from Guibas and Stolfi (1985) p.120, with slight
	modifications and a bug fix."
	| edge base |
	(area origin <= aPoint and:[aPoint <= area corner]) ifFalse:[self halt].
	edge := self locatePoint: aPoint.
	(edge origin = aPoint or:[edge destination = aPoint]) ifTrue:[^self].
	(edge isPointOn: aPoint) ifTrue:[
		edge := edge originPrev.
		edge originNext deleteEdge].
	"Connect the new point to the vertices of the containing
	triangle (or quadrilateral, if the new point fell on an
	existing edge.)"
	base := self quadEdgeClass new.
	(base first) origin: edge origin; destination: aPoint.
	base first spliceEdge: edge.
	startingEdge := base.
	[base := edge connectEdge: base first symmetric.
	edge := base first originPrev.
	edge leftNext == startingEdge first] whileFalse.
	"Examine suspect edges to ensure that the Delaunay condition is satisfied."
	[true] whileTrue:[ | t |
	t := edge originPrev.
	((edge isRightPoint: t destination) and:[
		self insideCircle: aPoint with: edge origin with: t destination with: edge destination])
			 ifTrue:[
					edge swapEdge.
					edge := edge originPrev.
	] ifFalse:[
		(edge originNext == startingEdge first) ifTrue:[^self]. "No more suspect edges"
		"pop a suspect edge"
		edge := edge originNext leftPrev]].! !

!Subdivision methodsFor: 'triangulation'!
insideCircle: aPoint with: a with: b with: c
	"Returns TRUE if the point d is inside the circle defined by the
	points a, b, c. See Guibas and Stolfi (1985) p.107."
	^(((a dotProduct: a) * (self triArea: b with: c with: aPoint)) -
	((b dotProduct: b) * (self triArea: a with: c with: aPoint)) +
	((c dotProduct: c) * (self triArea: a with: b with: aPoint)) -
	((aPoint dotProduct: aPoint) * (self triArea: a with: b with: c))) > 0.0! !

!Subdivision methodsFor: 'triangulation'!
locatePoint: aPoint
	"Returns an edge e, s.t. either x is on e, or e is an edge of
	a triangle containing x. The search starts from startingEdge
	and proceeds in the general direction of x. Based on the
	pseudocode in Guibas and Stolfi (1985) p.121."

	| edge |
	edge := startingEdge first.
	[true] whileTrue:[
		(aPoint = edge origin or:[aPoint = edge destination]) ifTrue:[^edge].
		(edge isRightPoint: aPoint) ifTrue:[edge := edge symmetric]
		ifFalse:[(edge originNext isRightPoint: aPoint) ifFalse:[edge := edge originNext]
		ifTrue:[(edge destPrev isRightPoint: aPoint) ifFalse:[edge := edge destPrev]
		ifTrue:[^edge]]]].! !

!Subdivision methodsFor: 'triangulation'!
splice: edge1 with: edge2

	edge1 spliceEdge: edge2! !

!Subdivision methodsFor: 'triangulation'!
triArea: a with: b with: c
	"Returns twice the area of the oriented triangle (a, b, c), i.e., the
	area is positive if the triangle is oriented counterclockwise."
	^((b x - a x) * (c y - a y)) - ((b y - a y) * (c x - a x))! !


!Subdivision methodsFor: 'initialize-release' stamp: 'ar 5/19/2001 16:47'!
p1: pt1 p2: pt2 p3: pt3
	| ea eb ec |
	point1 _ pt1.
	point2 _ pt2.
	point3 _ pt3.
	stamp _ 0.
	ea := self quadEdgeClass new.
	(ea first) origin: pt1; destination: pt2.
	eb := self quadEdgeClass new.
	self splice: ea first symmetric with: eb first.
	(eb first) origin: pt2; destination: pt3.
	ec := self quadEdgeClass new.
	self splice: eb first symmetric with: ec first.
	(ec first) origin: pt3; destination: pt1.
	self splice: ec first symmetric with: ea first.
	startingEdge := ea.
! !

!Subdivision methodsFor: 'initialize-release'!
withSize: aRectangle

	| offset scale p1 p2 p3 |
	area := aRectangle.
	"Construct a triangle containing area"
	offset := area origin.
	scale := area extent.
	p1 := (-1 at -1) * scale + offset.
	p2 := (2 at -1) * scale + offset.
	p3 := (0.5 at 3) * scale + offset.
	self p1: p1 p2: p2 p3: p3.! !

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

Subdivision class
	instanceVariableNames: ''!

!Subdivision class methodsFor: 'instance creation' stamp: 'ar 5/19/2001 21:54'!
constraintOutline: pointCollection
	^(self points: pointCollection shuffled) constraintOutline: pointCollection! !

!Subdivision class methodsFor: 'instance creation'!
points: pointCollection
	^self new points: pointCollection! !

!Subdivision class methodsFor: 'instance creation'!
withSize: rectangle
	^self new withSize: rectangle! !


!Subdivision class methodsFor: 'examples' stamp: 'ar 5/23/2001 22:43'!
example1	"Subdivision example1"
	| ptList subdivision |
	ptList _ ((5 to: 35) collect:[:i| i*10 at 50]),
			{350 at 75. 70 at 75. 70 at 100},
			((7 to: 35) collect:[:i| i*10 at 100]),
			{350 at 125. 50 at 125}.
	subdivision _ self points: ptList.
	self exampleDraw: subdivision points: ptList.
! !

!Subdivision class methodsFor: 'examples' stamp: 'ar 12/14/2004 11:53'!
example2	"Subdivision example2"
	"Same as example1, but this time using the outline constraints"
	| ptList subdivision |
	ptList _ ((5 to: 35) collect:[:i| i*10 at 50]),
			{350 at 75. 70 at 75. 70 at 100},
			((7 to: 35) collect:[:i| i*10 at 100]),
			{350 at 125. 50 at 125}.
	subdivision _ (self points: ptList) constraintOutline: ptList; yourself.
	self exampleDraw: subdivision points: ptList.
! !

!Subdivision class methodsFor: 'examples' stamp: 'ar 12/14/2004 11:54'!
example3	"Subdivision example3"
	"Same as example2 but marking edges"
	| ptList subdivision |
	ptList _ ((5 to: 35) collect:[:i| i*10 at 50]),
			{350 at 75. 70 at 75. 70 at 100},
			((7 to: 35) collect:[:i| i*10 at 100]),
			{350 at 125. 50 at 125}.
	subdivision _ (self points: ptList) constraintOutline: ptList; yourself.
	subdivision markExteriorEdges.
	self exampleDraw: subdivision points: ptList.
! !

!Subdivision class methodsFor: 'examples' stamp: 'ar 12/14/2004 11:54'!
example4	"Subdivision example4"
	"A nasty self-intersecting shape"
	"Same as example2 but marking edges"
	| ptList subdivision |
	ptList _ {
		50 at 100. 
		100 at 100.
		150 at 100.
		150 at 150.
		100 at 150.
		100 at 100.
		100 at 50.
		300 at 50.
		300 at 300.
		50 at 300.
	}.
	subdivision _ (self points: ptList) constraintOutline: ptList; yourself.
	subdivision markExteriorEdges.
	self exampleDraw: subdivision points: ptList.
! !

!Subdivision class methodsFor: 'examples' stamp: 'ar 5/23/2001 22:42'!
exampleDraw: subdivision points: ptList
	| canvas |
	Display fillWhite.
	canvas _ Display getCanvas.
	subdivision edgesDo:[:e|
		canvas line: e origin to: e destination width: 1 color: e classificationColor].
	ptList do:[:pt|
		canvas fillRectangle: (pt - 1 extent: 3 at 3) color: Color red.
	].
	Display restoreAfter:[].! !


Object subclass: #SubdivisionHalfEdge
	instanceVariableNames: 'id point quadEdge next'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Tools-Triangulation'!
!SubdivisionHalfEdge commentStamp: '<historical>' prior: 0!
I represent a half-edge within a subdivision.!


!SubdivisionHalfEdge methodsFor: 'private'!
ccw: a with: b with: c

	^(self triArea: a with: b with: c) > 0.0! !

!SubdivisionHalfEdge methodsFor: 'private'!
collectQuadEdgesInto: aSet

	(aSet includes: quadEdge) ifTrue:[^self].
	aSet add: quadEdge.
	self originNext collectQuadEdgesInto: aSet.
	self originPrev collectQuadEdgesInto: aSet.
	self destNext collectQuadEdgesInto: aSet.
	self destPrev collectQuadEdgesInto: aSet.
	^aSet! !

!SubdivisionHalfEdge methodsFor: 'private'!
displayOn: aGraphicsContext at: aPoint withSize: scaling stamp: timeStamp

	| v1 v2 |
	(quadEdge timeStamp = timeStamp) ifTrue:[^self].
	quadEdge timeStamp: timeStamp.
	v1 := self origin.
	v2 := self destination.
	aGraphicsContext 
		displayLineFrom: (v1 * scaling)+aPoint
		to: (v2 * scaling) + aPoint.
	self originNext displayOn: aGraphicsContext at: aPoint withSize: scaling stamp: timeStamp.
	self originPrev displayOn: aGraphicsContext at: aPoint withSize: scaling stamp: timeStamp.
	self destNext displayOn: aGraphicsContext at: aPoint withSize: scaling stamp: timeStamp.

	self destPrev displayOn: aGraphicsContext at: aPoint withSize: scaling stamp: timeStamp.! !

!SubdivisionHalfEdge methodsFor: 'private' stamp: 'imeStamp.!! !!
!!SubdivisionHalfEdge methodsFor: '!
isLeftPoint: aPoint

	^self ccw: aPoint with: self origin with: self destination! !

!SubdivisionHalfEdge methodsFor: 'private'!
isPointOn: aPoint
	"A predicate that determines if the point x is on the edge e.
	The point is considered on if it is in the EPS-neighborhood
	of the edge"
	| v1 v2 u v |
	v1 := aPoint - self origin.
	v2 := self destination - self origin.
	u := v1 dotProduct: v2.
	v := v1 crossProduct: v2.
	^(u isZero and:[v isZero])! !

!SubdivisionHalfEdge methodsFor: 'private'!
isRightPoint: aPoint

	^self ccw: aPoint with: self destination with: self origin! !

!SubdivisionHalfEdge methodsFor: 'private' stamp: 'ar 5/19/2001 16:46'!
quadEdgeClass
	^SubdivisionQuadEdge! !

!SubdivisionHalfEdge methodsFor: 'private'!
triArea: a with: b with: c
	"Returns twice the area of the oriented triangle (a, b, c), i.e., the
	area is positive if the triangle is oriented counterclockwise."
	^((b x - a x) * (c y - a y)) - ((b y - a y) * (c x - a x))! !


!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 17:40'!
center
	^self origin + self destination * 0.5! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 02:26'!
classificationColor
	^quadEdge classificationColor! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 00:26'!
classificationIndex
	"Return the classification index of the receiver"
	^quadEdge classificationIndex! !

!SubdivisionHalfEdge methodsFor: 'accessing'!
destination
	^self symmetric origin! !

!SubdivisionHalfEdge methodsFor: 'accessing'!
destination: aPoint
	self symmetric origin: aPoint! !

!SubdivisionHalfEdge methodsFor: 'accessing'!
destNext
	"Return the next ccw edge around (into) the destination of the current edge."
	^self symmetric originNext symmetric! !

!SubdivisionHalfEdge methodsFor: 'accessing'!
destPrev
	"Return the next cw edge around (into) the destination of the current edge."
	^self inverseRotated originNext inverseRotated! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/18/2001 21:05'!
end
	^self destination! !

!SubdivisionHalfEdge methodsFor: 'accessing'!
inverseRotated
	" Return the dual of the current edge, directed from its left to its right."
	^quadEdge edges at: (id > 1 ifTrue:[id-1] ifFalse:[id+3])! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 00:01'!
isBorderEdge
	^quadEdge isBorderEdge! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 00:01'!
isBorderEdge: aBool
	quadEdge isBorderEdge: aBool! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 00:15'!
isExteriorEdge
	^quadEdge isExteriorEdge! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 00:15'!
isExteriorEdge: aBool
	quadEdge isExteriorEdge: aBool! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 00:15'!
isInteriorEdge
	^quadEdge isInteriorEdge! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 00:15'!
isInteriorEdge: aBool
	quadEdge isInteriorEdge: aBool! !

!SubdivisionHalfEdge methodsFor: 'accessing'!
leftNext
	"Return the ccw edge around the left face following the current edge."
	^self inverseRotated originNext rotated! !

!SubdivisionHalfEdge methodsFor: 'accessing'!
leftPrev
	"Return the ccw edge around the left face before the current edge."
	^self originNext symmetric! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 18:02'!
length
	^self start dist: self end! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 21:24'!
nextBorderEdge
	| edge |
	edge _ self originNext.
	[edge == self] whileFalse:[
		edge isBorderEdge ifTrue:[^edge symmetric].
		edge _ edge originNext].
	^nil! !

!SubdivisionHalfEdge methodsFor: 'accessing'!
next: aDelauneyEdge

	next := aDelauneyEdge.! !

!SubdivisionHalfEdge methodsFor: 'accessing'!
origin
	^point! !

!SubdivisionHalfEdge methodsFor: 'accessing'!
originNext
	"Return the next ccw edge around (from) the origin of the current edge."
	^next! !

!SubdivisionHalfEdge methodsFor: 'accessing'!
originPrev
	" Return the next cw edge around (from) the origin of the current edge."
	^self rotated originNext rotated! !

!SubdivisionHalfEdge methodsFor: 'accessing'!
origin: aPoint
	point := aPoint! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 01:20'!
quadEdge
	^quadEdge! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 01:20'!
rightNext
	"Return the edge around the right face ccw following the current edge."
	^self rotated originNext inverseRotated! !

!SubdivisionHalfEdge methodsFor: 'accessing'!
rightPrev
	"Return the edge around the right face ccw before the current edge."
	^self symmetric originNext! !

!SubdivisionHalfEdge methodsFor: 'accessing'!
rotated
	" Return the dual of the current edge, directed from its right to its left"
	^quadEdge edges at: (id < 4 ifTrue:[id+1] ifFalse:[id-3])! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 18:06'!
squaredLength
	^self start dotProduct: self end! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/18/2001 21:05'!
start
	^self origin! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/18/2001 21:05'!
symmetric
	"Return the edge from the destination to the origin of the current edge."
	^quadEdge edges at:(id < 3 ifTrue:[id+2] ifFalse:[id - 2]).! !

!SubdivisionHalfEdge methodsFor: 'accessing' stamp: 'ar 5/18/2001 21:00'!
timeStamp
	^quadEdge timeStamp! !


!SubdivisionHalfEdge methodsFor: 'topological operators' stamp: 'ar 5/19/2001 16:47'!
connectEdge: edge
	"Add a new edge e connecting the destination of a to the
	origin of b, in such a way that all three have the same
	left face after the connection is complete.
	Additionally, the data pointers of the new edge are set."
	| e |
	e := self quadEdgeClass new.
	e first spliceEdge: self leftNext.
	e first symmetric spliceEdge: edge.
	(e first) origin: self destination; destination: edge origin.
	^e! !

!SubdivisionHalfEdge methodsFor: 'topological operators'!
deleteEdge

	self spliceEdge: self originPrev.
	self symmetric spliceEdge: self symmetric originPrev.! !

!SubdivisionHalfEdge methodsFor: 'topological operators'!
spliceEdge: edge
	"This operator affects the two edge rings around the origins of a and b,
	and, independently, the two edge rings around the left faces of a and b.
	In each case, (i) if the two rings are distinct, Splice will combine
	them into one; (ii) if the two are the same ring, Splice will break it
	into two separate pieces.
	Thus, Splice can be used both to attach the two edges together, and
	to break them apart. See Guibas and Stolfi (1985) p.96 for more details
	and illustrations."
	| alpha beta t1 t2 t3 t4 |
	alpha := self originNext rotated.
	beta := edge originNext rotated.

	t1 := edge originNext.
	t2 := self originNext.
	t3 := beta originNext.
	t4 := alpha originNext.

	self next: t1.
	edge next: t2.
	alpha next: t3.
	beta next: t4.! !

!SubdivisionHalfEdge methodsFor: 'topological operators'!
swapEdge
	"Essentially turns edge e counterclockwise inside its enclosing
	quadrilateral. The data pointers are modified accordingly."

	| a b |
	a := self originPrev.
	b := self symmetric originPrev.
	self spliceEdge: a.
	self symmetric spliceEdge: b.
	self spliceEdge: a leftNext.
	self symmetric spliceEdge: b leftNext.
	self origin: a destination; destination: b destination.! !


!SubdivisionHalfEdge methodsFor: 'enumeration' stamp: 'ar 5/18/2001 20:59'!
edgesDo: aBlock stamp: timeStamp
	(quadEdge timeStamp = timeStamp) ifTrue:[^self].
	quadEdge timeStamp: timeStamp.
	aBlock value: self.
	self originNext edgesDo: aBlock stamp: timeStamp.
	self originPrev edgesDo: aBlock stamp: timeStamp.
	self destNext edgesDo: aBlock stamp: timeStamp.
	self destPrev edgesDo: aBlock stamp: timeStamp.! !

!SubdivisionHalfEdge methodsFor: 'enumeration' stamp: 'ar 5/19/2001 14:13'!
markExteriorEdges: timeStamp
	| nextEdge |
	quadEdge timeStamp = timeStamp ifTrue:[^self].
	quadEdge timeStamp: timeStamp.
	self isExteriorEdge: true.
	nextEdge _ self.
	[nextEdge _ nextEdge originNext.
	nextEdge == self or:[nextEdge isBorderEdge]] whileFalse:[
		nextEdge symmetric markExteriorEdges: timeStamp.
	].
	nextEdge _ self.
	[nextEdge _ nextEdge originPrev.
	nextEdge == self or:[nextEdge isBorderEdge]] whileFalse:[
		nextEdge symmetric markExteriorEdges: timeStamp.
	].! !

!SubdivisionHalfEdge methodsFor: 'enumeration' stamp: 'ar 5/19/2001 17:23'!
triangleEdges: timeStamp do: aBlock
	| e1 e2 e3 |
	"Evaluate aBlock with all edges making up triangles"
	quadEdge timeStamp = timeStamp ifTrue:[^self].
	quadEdge timeStamp: timeStamp.
	e1 _ self.
	e3 _ self originNext symmetric.
	e2 _ e3 originNext symmetric.
	(e2 timeStamp = timeStamp or:[e3 timeStamp = timeStamp])
		ifFalse:[aBlock value: e1 value: e2 value: e3].
	e1 _ self originPrev.
	e3 _ self symmetric.
	e2 _ e3 originNext symmetric.
	(e1 timeStamp = timeStamp or:[e2 timeStamp = timeStamp])
		ifFalse:[aBlock value: e1 value: e2 value: e3].
	self originNext triangleEdges: timeStamp do: aBlock.
	self originPrev triangleEdges: timeStamp do: aBlock.
	self destNext triangleEdges: timeStamp do: aBlock.
	self destPrev triangleEdges: timeStamp do: aBlock.! !


!SubdivisionHalfEdge methodsFor: 'initialize-release'!
id: aNumber owner: aDelauneyQuadEdge

	id := aNumber.
	quadEdge := aDelauneyQuadEdge.! !


!SubdivisionHalfEdge methodsFor: 'printing'!
printOn: aStream

	aStream
		nextPutAll: self class name;
		nextPut:$(;
		print: (self origin);
		nextPut:$/;
		print: self destination;
		nextPut:$);
		yourself! !

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

SubdivisionHalfEdge class
	instanceVariableNames: ''!

!SubdivisionHalfEdge class methodsFor: 'accessing'!
splice: edge1 with: edge2
	"This operator affects the two edge rings around the origins of a and b,
	and, independently, the two edge rings around the left faces of a and b.
	In each case, (i) if the two rings are distinct, Splice will combine
	them into one; (ii) if the two are the same ring, Splice will break it
	into two separate pieces.
	Thus, Splice can be used both to attach the two edges together, and
	to break them apart. See Guibas and Stolfi (1985) p.96 for more details
	and illustrations."
	| alpha beta t1 t2 t3 t4 |
	alpha := edge1 originNext rotated.
	beta := edge2 originNext rotated.

	t1 := edge2 originNext.
	t2 := edge1 originNext.
	t3 := beta originNext.
	t4 := alpha originNext.

	edge1 next: t1.
	edge2 next: t2.
	alpha next: t3.
	beta next: t4.! !


Object subclass: #SubdivisionQuadEdge
	instanceVariableNames: 'edges flags timeStamp'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Tools-Triangulation'!
!SubdivisionQuadEdge commentStamp: '<historical>' prior: 0!
I represent a quad-edge within a subdivision.!


!SubdivisionQuadEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 02:28'!
classificationColor
	"Return the classification index of the receiver"
	| r g b |
	r _ self isInteriorEdge ifTrue:[1] ifFalse:[0].
	g _ self isExteriorEdge ifTrue:[1] ifFalse:[0].
	b _ self isBorderEdge ifTrue:[1] ifFalse:[0].
	^Color r: r g: g b: b.! !

!SubdivisionQuadEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 00:27'!
classificationIndex
	"Return the classification index of the receiver"
	^flags bitAnd: 7! !

!SubdivisionQuadEdge methodsFor: 'accessing'!
edges
	^edges! !

!SubdivisionQuadEdge methodsFor: 'accessing'!
first
	^edges first! !

!SubdivisionQuadEdge methodsFor: 'accessing' stamp: 'ar 5/18/2001 23:58'!
flags
	^flags! !

!SubdivisionQuadEdge methodsFor: 'accessing' stamp: 'ar 5/18/2001 23:58'!
flags: newFlags
	flags _ newFlags! !

!SubdivisionQuadEdge methodsFor: 'accessing' stamp: 'ar 5/18/2001 23:59'!
isBorderEdge
	^flags anyMask: 1! !

!SubdivisionQuadEdge methodsFor: 'accessing' stamp: 'ar 5/18/2001 23:59'!
isBorderEdge: aBool
	flags _ aBool ifTrue:[flags bitOr: 1] ifFalse:[flags bitClear: 1].! !

!SubdivisionQuadEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 00:15'!
isExteriorEdge
	^flags anyMask: 4! !

!SubdivisionQuadEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 00:15'!
isExteriorEdge: aBool
	flags _ aBool ifTrue:[flags bitOr: 4] ifFalse:[flags bitClear: 4].! !

!SubdivisionQuadEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 00:16'!
isInteriorEdge
	^flags anyMask: 2! !

!SubdivisionQuadEdge methodsFor: 'accessing' stamp: 'ar 5/19/2001 00:16'!
isInteriorEdge: aBool
	flags _ aBool ifTrue:[flags bitOr: 2] ifFalse:[flags bitClear: 2].! !

!SubdivisionQuadEdge methodsFor: 'accessing'!
timeStamp
	^timeStamp! !

!SubdivisionQuadEdge methodsFor: 'accessing'!
timeStamp: aNumber
	timeStamp := aNumber! !


!SubdivisionQuadEdge methodsFor: 'private' stamp: 'ar 5/19/2001 22:51'!
edgeClass
	^SubdivisionHalfEdge! !


!SubdivisionQuadEdge methodsFor: 'initialize-release' stamp: 'ar 5/19/2001 16:46'!
initialize
	edges := Array new: 4.
	1 to: 4 do:[:i| edges at: i put: (self edgeClass new id: i owner: self)].
	(edges at: 1) next: (edges at: 1).
	(edges at: 2) next: (edges at: 4).
	(edges at: 3) next: (edges at: 3).
	(edges at: 4) next: (edges at: 2).
	timeStamp := 0.
	flags _ 0.! !

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

SubdivisionQuadEdge class
	instanceVariableNames: ''!

!SubdivisionQuadEdge class methodsFor: 'instance creation' stamp: 'ar 12/14/2004 11:58'!
new
	^self basicNew initialize! !


More information about the Squeak-dev mailing list