'From Squeak3.1alpha of 28 February 2001 [latest update: #4064] on 24 May 2001 at 1:54:07 pm'! "Change Set: Triangulation-ar Date: 24 May 2001 Author: Andreas Raab Providing a tool for computing incremental (constraint) delauney triangulations."! Object subclass: #Subdivision instanceVariableNames: 'area startingEdge point1 point2 point3 stamp outlineThreshold ' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Tools-Triangulation'! !Subdivision commentStamp: '' prior: 0! I perform (constraint) delauney triangulations on a set of points. See my class side for examples.! Subdivision class instanceVariableNames: ''! Object subclass: #SubdivisionHalfEdge instanceVariableNames: 'id point quadEdge next ' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Tools-Triangulation'! !SubdivisionHalfEdge commentStamp: '' prior: 0! I represent a half-edge within a subdivision.! SubdivisionHalfEdge class instanceVariableNames: ''! Object subclass: #SubdivisionQuadEdge instanceVariableNames: 'edges flags timeStamp ' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Tools-Triangulation'! !SubdivisionQuadEdge commentStamp: '' prior: 0! I represent a quad-edge within a subdivision.! SubdivisionQuadEdge class instanceVariableNames: ''! !Point methodsFor: 'point functions' stamp: 'ar 5/22/2001 23:46'! insideTriangle: p1 with: p2 with: p3 "Return true if the receiver is within the triangle defined by the three coordinates. Note: This method computes the barycentric coordinates for the receiver and tests those coordinates." | p0 b0 b1 b2 b3 | p0 _ self. b0 _ ((p2 x - p1 x) * (p3 y - p1 y)) - ((p3 x - p1 x) * (p2 y - p1 y)). b0 isZero ifTrue:[^false]. "degenerate" b0 _ 1.0 / b0. b1 _ (((p2 x - p0 x) * (p3 y - p0 y)) - ((p3 x - p0 x) * (p2 y - p0 y))) * b0. b2 _ (((p3 x - p0 x) * (p1 y - p0 y)) - ((p1 x - p0 x) * (p3 y - p0 y))) * b0. b3 _ (((p1 x - p0 x) * (p2 y - p0 y)) - ((p2 x - p0 x) * (p1 y - p0 y))) * b0. b1 < 0.0 ifTrue:[^false]. b2 < 0.0 ifTrue:[^false]. b3 < 0.0 ifTrue:[^false]. ^true ! ! !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: '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 5/19/2001 14:29'! constraintOutline: pointList "Make sure all line segments in the given closed outline appear in the triangulation." | lastPt nextPt lastEdge nextEdge | outlineThreshold ifNil:[outlineThreshold _ 1.0e-3]. lastPt _ pointList last. lastEdge _ self locatePoint: lastPt. lastEdge origin = lastPt ifFalse:[lastEdge _ lastEdge symmetric]. 1 to: pointList size do:[:i| nextPt _ pointList at: i. lastPt = nextPt ifFalse:[ nextEdge _ self assureEdgeFrom: lastPt to: nextPt lastEdge: lastEdge. nextEdge ifNil:[ nextEdge _ self locatePoint: nextPt. lastEdge destination = nextPt ifFalse:[lastEdge _ lastEdge symmetric]. ]. lastEdge _ nextEdge symmetric originNext]. lastPt _ nextPt. ]. ! ! !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 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: '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@-1) * scale + offset. p2 := (2@-1) * scale + offset. p3 := (0.5@3) * scale + offset. self p1: p1 p2: p2 p3: p3.! ! !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@-1.0. max := 1.0@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: '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: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 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 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 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@50]), {350@75. 70@75. 70@100}, ((7 to: 35) collect:[:i| i*10@100]), {350@125. 50@125}. subdivision _ self points: ptList. self exampleDraw: subdivision points: ptList. ! ! !Subdivision class methodsFor: 'examples' stamp: 'ar 5/23/2001 22:43'! example2 "Subdivision example2" "Same as example1, but this time using the outline constraints" | ptList subdivision | ptList _ ((5 to: 35) collect:[:i| i*10@50]), {350@75. 70@75. 70@100}, ((7 to: 35) collect:[:i| i*10@100]), {350@125. 50@125}. subdivision _ self constraintOutline: ptList. self exampleDraw: subdivision points: ptList. ! ! !Subdivision class methodsFor: 'examples' stamp: 'ar 5/23/2001 22:43'! example3 "Subdivision example3" "Same as example2 but marking edges" | ptList subdivision | ptList _ ((5 to: 35) collect:[:i| i*10@50]), {350@75. 70@75. 70@100}, ((7 to: 35) collect:[:i| i*10@100]), {350@125. 50@125}. subdivision _ self constraintOutline: ptList. subdivision markExteriorEdges. self exampleDraw: subdivision points: ptList. ! ! !Subdivision class methodsFor: 'examples' stamp: 'ar 5/23/2001 22:43'! example4 "Subdivision example4" "A nasty self-intersecting shape" "Same as example2 but marking edges" | ptList subdivision | ptList _ { 50@100. 100@100. 150@100. 150@150. 100@150. 100@100. 100@50. 300@50. 300@300. 50@300. }. subdivision _ self constraintOutline: ptList. 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@3) color: Color red. ]. Display restoreAfter:[].! ! !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'! 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'! destination ^self symmetric origin! ! !SubdivisionHalfEdge methodsFor: 'accessing'! destination: aPoint self symmetric origin: aPoint! ! !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'! next: aDelauneyEdge next := aDelauneyEdge.! ! !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'! origin ^point! ! !SubdivisionHalfEdge methodsFor: 'accessing'! origin: aPoint point := aPoint! ! !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' stamp: 'ar 5/19/2001 01:20'! quadEdge ^quadEdge! ! !SubdivisionHalfEdge methodsFor: 'accessing'! 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'! 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: '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'! 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: '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: '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 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 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.! ! !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: '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 methodsFor: 'private' stamp: 'ar 5/19/2001 22:51'! edgeClass ^SubdivisionHalfEdge! ! !SubdivisionQuadEdge class methodsFor: 'instance creation'! new ^super new initialize! ! !Subdivision reorganize! ('triangulation' insertPoint: insideCircle:with:with:with: locatePoint: splice:with: triArea:with:with:) ('constraints' assureEdgeFrom:to:lastEdge: constraintOutline: insertEdgeFrom:to:lastEdge: insertSpine markExteriorEdges) ('initialize-release' p1:p2:p3: withSize:) ('accessing' edges faces outlineThreshold outlineThreshold: points: startingEdge) ('private' debugDraw edgesDo: innerTriangleEdgesDo: innerTriangleVerticesDo: innerTriangles quadEdgeClass trianglesDo:) !