DIRECTORY Graphics USING [black, Box, Color, Context, DrawArea, GetBounds, MoveTo, LineTo, DrawBox, SetColor, white], GraphicsColor USING [IntensityToColor], Process USING [Detach, GetPriority, Pause, Priority, priorityBackground, MsecToTicks, SetPriority], ViewerClasses, TIPTables USING [TIPScreenCoords], Rope USING [ROPE], TIPUser USING [InstantiateNewTIPTable, TIPTable], ViewerOps USING [RegisterViewerClass, CreateViewer, PaintViewer], Menus USING [Menu, MenuProc, CreateMenu, AppendMenuEntry], ViewerMenus USING [Close, Grow, Destroy, Move], IO USING [STREAM, CreateTTYStreams, PutF, int, real, Close, GetInt], Random USING [Init, Next], List USING [Comparison, Sort, Length, equal, less, greater, IsAListOfRefAny], COGCart, Real USING [SqRt, LargestNumber, Float], COGHomo; COGVoronoi: CEDAR MONITOR IMPORTS Graphics, GraphicsColor, Process, ViewerOps, IO, ViewerMenus, Random, Menus, COGHomo, TIPUser, Real, List = TRUSTED BEGIN OPEN Homo: COGHomo, Cart: COGCart, Real, Rope, IO; -- VORONOI/DELAUNAY DATA STRUCTURE - - - - - - - - - - - - - - - - - - - - - - - - - - Edge: TYPE = RECORD [-- Delaunay diagram links: dest: REF DVertex, -- destination vData point fNext: REF Edge, -- next edge c.c.w. on Delaunay face at left vNext: REF Edge, -- next edge c.c.w. with same Delaunay vertex as origin sym: REF Edge, -- record for the same edge in the opposite orientation leftVV: REF VVertex -- voronoi vertex corresponding to Delaunay face at left of edge ]; HPoint: TYPE = Homo.Point; Point: TYPE = Cart.Point; DVertex: TYPE = -- Delaunay vertex (= vData point = Voronoi region) RECORD [dp: HPoint, -- Data point anEdge: REF Edge, -- some edge out of the vData point painted: BOOL _ FALSE, -- set by PaintMe when all edges out from here have been painted no: NAT, -- vertex number (or order, after SortRegions) -- The following fields are used as temprorary storage by various routines nBlockers: NAT _ 0 -- number of neighbors that precede it in the 'blocks' relation ]; VVertex: TYPE = RECORD [vp: Homo.Point, -- Voronoi vertex (= circumcenter of Delaunay face) anEdge: REF Edge -- an edge of that Delaunay face ]; EdgeList: TYPE = LIST OF REF Edge; DVertexList: TYPE = LIST OF REF DVertex; DelaunayDiagram: TYPE = RECORD [points: LIST OF REF DVertex, viewer: ViewerClasses.Viewer -- where it is being shown ]; FPrev: INTERNAL PROC [e: REF Edge] RETURNS [ne: REF Edge] = TRUSTED INLINE {RETURN [(e.vNext).sym]}; FNext: INTERNAL PROC [e: REF Edge] RETURNS [ne: REF Edge] = TRUSTED INLINE {RETURN [e.fNext]}; VPrev: INTERNAL PROC [e: REF Edge] RETURNS [ne: REF Edge] = TRUSTED INLINE {RETURN [(e.sym).fNext]}; VNext: INTERNAL PROC [e: REF Edge] RETURNS [ne: REF Edge] = TRUSTED INLINE {RETURN [e.vNext]}; Dest: INTERNAL PROC [e: REF Edge] RETURNS [d: REF DVertex] = TRUSTED INLINE {RETURN [e.dest]}; Org: INTERNAL PROC [e: REF Edge] RETURNS [o: REF DVertex] = TRUSTED INLINE {RETURN [(e.sym).dest]}; LeftVV: INTERNAL PROC [e: REF Edge] RETURNS [lv: REF VVertex] = TRUSTED INLINE {RETURN [e.leftVV]}; RightVV: INTERNAL PROC [e: REF Edge] RETURNS [rv: REF VVertex] = TRUSTED INLINE {RETURN [(e.sym).leftVV]}; ComputeVoronoiVertex: INTERNAL PROC [p, q, r: Homo.Point] RETURNS [v: Homo.Point] = TRUSTED BEGIN -- Computes the Voronoi vertex that corresponds to the Delaunay face passing through p, q and r (i.e., their circumcenter). If p, q and r do not form a convex angle, they are assumed to be on the convex hull; in that case, the infinity point perpendicular to pq is returned. IF Homo.Convex [p, q, r] THEN {v _ Homo.CircumCenter [p, q, r]} ELSE {dir: Homo.Vector _ Homo.Sub[q, p]; v _ IF dir.w < 0.0 THEN [dir.y, -dir.x, 0.0] ELSE [-dir.y, dir.x, 0.0]} END; ConnectPoints: INTERNAL PROC [p, q: REF DVertex, ep, eq: REF Edge, lv, rv: REF VVertex] RETURNS [e: REF Edge] = TRUSTED BEGIN -- inserts an edge e (and its symmetrical) between the Delaunay vertices p and q. -- ep must be the edge out of p preceding immediately e c.c.w., -- and eq must be the edge out of q immediately preceding e.sym c.c.w. out.PutF["Adding edge (%g, %g)", int[p.no], int[q.no]]; IF ep # NIL THEN out.PutF[" after (%g, %g) at p ", int[Org[ep].no], int[Dest[ep].no]]; IF eq # NIL THEN out.PutF[" after (%g, %g) at q", int[Org[eq].no], int[Dest[eq].no]]; out.PutF["...\n"]; e _ NEW [Edge _ [dest: q, fNext: NIL, vNext: NIL, sym: NIL, leftVV: lv]]; e.sym _ NEW [Edge _ [dest: p, fNext: NIL, vNext: NIL, sym: e, leftVV: rv]]; lv.anEdge _ e; rv.anEdge _ e.sym; IF ep # NIL THEN {e.vNext _ ep.vNext; e.sym.fNext _ ep; ep.vNext.sym.fNext _ e; ep.vNext _ e} ELSE {e.vNext _ e; e.sym.fNext _ e; p.anEdge _ e}; IF eq # NIL THEN {e.sym.vNext _ eq.vNext; e.fNext _ eq; eq.vNext.sym.fNext _ e.sym; eq.vNext _ e.sym} ELSE {e.sym.vNext _ e.sym; e.fNext _ e.sym; q.anEdge _ e.sym} END; DeleteEdge: INTERNAL PROC [e: REF Edge] = TRUSTED BEGIN -- Deletes the edge e (and its symmetrical). p: REF DVertex = Org[e]; q: REF DVertex = Dest[e]; ep: REF Edge = VPrev[e]; eq: REF Edge = VPrev[e.sym]; out.PutF["Deleting edge (%g, %g)...\n", int[p.no], int[q.no]]; IF ep # e THEN {ep.vNext _ e.vNext; e.vNext.sym.fNext _ ep; IF p.anEdge = e THEN p.anEdge _ ep} ELSE p.anEdge _ NIL; IF eq # e THEN {eq.vNext _ e.sym.vNext; e.sym.vNext.sym.fNext _ eq; IF q.anEdge = e.sym THEN q.anEdge _ eq} ELSE q.anEdge _ NIL END; DumbLocateInVoronoi: INTERNAL PROC [p: Point, Diag: REF DelaunayDiagram] RETURNS [np: REF DVertex] = TRUSTED BEGIN -- Returns the face of the Voronoi containing point p -- Temporary version - uses exhaustive enumeration pts: LIST OF REF DVertex _ Diag.points; pa: REF DVertex; hp: HPoint _ [p.x, p.y, 1.0]; minD: REAL; paD: REAL; np _ pts.first; pts _ pts.rest; minD _ Homo.DistSq[np.dp, hp]; WHILE pts # NIL DO pa _ pts.first; IF Homo.FinPt[pa.dp] AND minD > (paD _ Homo.DistSq[pa.dp, hp]) THEN {minD _ paD; np _ pa}; pts _ pts.rest ENDLOOP END; nDV: NAT; -- serial number of last Delaunay vertex created InsertInVoronoi: INTERNAL PROC [newP: Point, Diag: REF DelaunayDiagram] = TRUSTED BEGIN -- Adds a new finite vData point newP to the Delaunay diagram Diag -- Temporary version - produces a triangulation in any case. f0: REF DVertex _ DumbLocateInVoronoi [newP, Diag]; p: REF DVertex = NEW [DVertex _ [dp: [newP.x, newP.y, 1.0], no: (nDV _ nDV+1), anEdge: NIL]]; q, f, fn: REF DVertex; ef: REF Edge _ f0.anEdge; ep, eq, en: REF Edge; out.PutF ["Inserting point at [%g, %g]...\n", real[newP.x], real[newP.y]]; ShowPoint [Diag, p.dp, thin]; ShowPoint [Diag, f0.dp, bold]; IF p.dp = f0.dp THEN {out.PutF["Duplicate point - ignored\n"]; RETURN}; -- locate some neighbor f of f0 following p c.c.w. -- WHILE Homo.Convex [p.dp, f0.dp, Dest[ef].dp] DO ef _ VNext[ef] ENDLOOP; -- locate the new neighbors of p (in c.c.w. order) and delete diagonal edges between them -- q _ f0; DO out.PutF["Will connect to vertex %g.\n", int[q.no]]; -- find the first neighbor of q that immediately precedes p c.c.w. around q -- DO ef _ VPrev[ef]; IF Homo.Convex [p.dp, q.dp, Dest[ef].dp] THEN EXIT ENDLOOP; f _ Dest [ef]; -- delete diagonal edges from q -- DO -- check whether ef is gonna stay in the final Delaunay -- en _ VPrev[ef]; fn _ Dest[en]; IF NOT Homo.Convex[p.dp, q.dp, fn.dp] OR NOT Homo.Convex[fn.dp, f.dp, p.dp] OR Homo.ShouldConnect24[p.dp, q.dp, fn.dp, f.dp] THEN EXIT; ShowEdge [Diag, ef, boldGray]; DeleteEdge [ef]; ef _ en; f _ fn ENDLOOP; -- found the next neighbor of p: it is f -- -- fix LeftVV of edge ef ef.leftVV _ NEW [VVertex _ [vp: ComputeVoronoiVertex [p.dp, q.dp, f.dp], anEdge: ef ]]; ShowEdge [Diag, ef, bold]; q _ f; ef _ ef.sym; IF q = f0 THEN EXIT ENDLOOP; -- add p and the Delaunay edges from it to the Delaunay face just created ep _ NIL; ef _ VPrev[ef]; DO -- connect p and q (ef is the edge immediately preceding (q,p) c.c.w around q, -- and ep is the one immediately preceding (p,q) c.c.w. around p)-- eq _ ConnectPoints [q, p, ef, ep, LeftVV[ef], RightVV[VNext[ef]]]; ep _ eq.sym; ShowEdge [Diag, ep, bold]; q _ Dest [ef]; ef _ FNext [ef]; IF q = f0 THEN EXIT ENDLOOP; -- add p to the list of points -- Diag.points _ CONS [p, Diag.points] END; SortRegions: INTERNAL PROC [Diag: REF DelaunayDiagram, trace: BOOL] RETURNS [sortedPts: LIST OF REF DVertex] = TRUSTED BEGIN -- Sorts the finite vertices of a Delaunay diagram in such a way that, for any two -- adjacent points, the leftmost one occurs first. When this rule (and its transitive -- closure) are insufficient to decide the ordering of two points, the one with lowest -- y occurs first. -- The final ordering is given by the 'no' field of each vertex and by the list sortedPts. -- also, p.anEdge will point to the (finite) neighbor of p that follows p and has maximum y. -- Infinite data points will get p.no = -1, -2, -3, ... and will be omitted from the sorted list. -- The number of finite points is returned in n. maximum y. pts, finPts, stack, free, t: LIST OF REF DVertex; pBq, pBprev: BOOL; p, q: REF DVertex; order, infOrder: NAT; e0, ea, ePrev: REF Edge; pts _ Diag.points; out.PutF ["SortRegions - first pass...\n"]; WHILE pts # NIL DO p _ pts.first; pts _ pts.rest; p.nBlockers _ 0; -- Counts blocking neighbors of p -- Also puts in eTop and in p.anEdge the edge blocked by p with Dest of maximum y -- Also finds first vertex in the ordering and initializes the Qyu to it. e0 _ ea _ p.anEdge; ePrev _ VPrev [e0]; pBprev _ Homo.Precedes [p.dp, Dest[ePrev].dp]; out.PutF ["Looking at point %g\n", int[p.no]]; DO q _ Dest[ea]; pBq _ Homo.Precedes [p.dp, q.dp]; IF NOT pBq THEN {IF pBprev THEN p.anEdge _ ePrev; p.nBlockers _ p.nBlockers + 1}; ePrev _ ea; pBprev _ pBq; ea _ VNext[ea]; IF ea = e0 THEN EXIT ENDLOOP; -- delete p from points list and put in free list (or prime the stack if p is first in ordering) IF p.nBlockers = 0 THEN {stack _ LIST [p]; out.PutF["Point %g is first.\n", int[p.no]]} ENDLOOP; -- topological sorting: removes a vertex from the stack, -- decrements ref.counts of blocked neighbors, -- pushes freed neighbors into stack (in proper y order) out.PutF ["SortRegions - second pass...\n"]; order _ 0; sortedPts _ finPts _ NIL; infOrder _ -1; WHILE stack # NIL DO p _ stack.first; out.PutF["Looking at point %g\n", int[p.no]]; IF trace THEN ShowRegion [Diag, p, thin]; t _ stack; stack _ stack.rest; IF Homo.FinPt[p.dp] THEN {p.no _ order; order _ order + 1; IF sortedPts = NIL THEN sortedPts _ t ELSE finPts.rest _ t; finPts _ t; t.rest _ NIL} ELSE {p.no _ infOrder; infOrder _ infOrder - 1}; e0 _ ea _ p.anEdge; WHILE Homo.Precedes [p.dp, (q _ Dest[ea]).dp] DO IF trace THEN ShowEdge [Diag, ea, bold]; q.nBlockers _ q.nBlockers - 1; IF q.nBlockers = 0 THEN {stack _ CONS [q, stack]}; ea _ VPrev[ea]; -- note: cw order here IF ea = e0 THEN EXIT ENDLOOP; ENDLOOP; Diag.points _ pts; out.PutF ["Exit SortRegions.\n"] END; YTest: TYPE = RECORD [testY: REAL, up, dn: REF -- to YTest or EdgeTest or DVertex ]; EdgeTest: TYPE = RECORD [edge: REF Edge, left, right: REF -- to YTest or EdgeTest or DVertex ]; TreeRoot: TYPE = REF ANY; -- root of a Lee-Preparata tree: EdgeTest, YTest, or DVertex BuildLeePreparataStructure: INTERNAL PROC[Diag: REF DelaunayDiagram, trace: BOOL] RETURNS [leep: REF] = TRUSTED BEGIN -- Builds the Lee-Preparata tree structure for point location -- Each chain is at first collected as list of edges; these are sorted by ascending y coordinate, and a chain tree is built from them. Since every edge is represented in only one chain (of highest possible level), there may be one or more gaps in the ranges of y-values covered by a given chain. A DummyEdge is temporarily inserted in each of those gaps (but not in the final structure). DummyEdge: TYPE = RECORD [topY: REAL, onLeft: BOOL -- TRUE if gap corresponds to edge(s) of a left ancestor of the chain ]; -- Once the Voronoi regions have been sorted from left to right, each edge can be assigned to a specific chain based on the ranks of the two regions on each side of it. If the regions are numbered in the range [0..n) (n>1), the root chain separates regions [0..k) and [k..n), where k = n DIV 2 is the chain index. Each group of regions is split in half by a child of chain k, and so forth; in generla, if at some step the set of regions is [fst..lim) (with lim > fst+1), the root chain will separate regions [fst..r) from [r..lim), where r = (fst+lim) DIV 2. The chain indices will lie therefore in the range (0..n). -- Given two adjacent regions i and j, the edge between them will belong to a unique chain whose index, LCA[i, j], is computed by the following procedure. ChainIndex: PROC [i, j: NAT] RETURNS [ix: NAT] = TRUSTED BEGIN -- Returns the index of the monotone chain that separates region i from region j (i#j) -- and has highest possible level in the Lee-Preparata tree. fst: NAT _ 0; lim: NAT _ n; DO -- assert: i and j IN [fst..lim) ix _ (fst + lim)/2; IF i < ix THEN IF j < ix THEN lim _ ix ELSE RETURN ELSE IF j < ix THEN RETURN ELSE fst _ ix ENDLOOP END; Descendants: PROC [ix: NAT] RETURNS [fst, lim: NAT] = TRUSTED BEGIN -- Returns fst and lim such that LCA[i, j] = ix iff i IN [fst..ix) and j IN [ix..lim). av: NAT; fst _ 0; lim _ n; DO -- assert: ix IN [fst..lim) av _ (fst + lim)/2; IF ix < av THEN lim _ av ELSE IF ix > av THEN fst _ av ELSE RETURN ENDLOOP END; -- The folowing records are temporary data structures. ChainTable: TYPE = RECORD [elist: SEQUENCE nLists: NAT OF EdgeList ]; TipsTable: TYPE = RECORD [tip: SEQUENCE nRegs: NAT OF REF VVertex ]; RegionTable: TYPE = RECORD [dvertex: SEQUENCE nRegs: NAT OF REF DVertex ]; n: NAT; -- number of finite data points in the diagram edges: REF ChainTable; -- edges in each Lee-Preparata chain tips: REF TipsTable; -- upper Voronoi vertices of each region regions: REF RegionTable; -- upper Voronoi vertices of each region SetUpTables: INTERNAL PROC = TRUSTED BEGIN -- Sorts the regions from left to right and sets the chain table in such a way that -- an edge between region i and region j is in edges[ChainIndex[i, j]]. -- Returns also in regions.dvertex[k] a pointer to region k, and in -- regions.tip[k] the its point with maximum y. pts: DVertexList _ SortRegions [Diag, FALSE]; p, q: REF DVertex; e, e0: REF Edge; highest: BOOL; ix: NAT; n _ List.Length[List.IsAListOfRefAny[pts].list]; edges _ NEW [ChainTable[n]]; tips _ NEW [TipsTable[n]]; regions _ NEW [RegionTable[n]]; -- enumerate the edges of the delaunay WHILE pts # NIL DO p _ pts.first; pts _ pts.rest; e _ e0 _ p.anEdge; regions[p.no] _ p; WHILE e # e0 DO q _ Dest[e]; IF p.no < q.no THEN {ix _ ChainIndex [p.no, q.no]; IF Homo.Below[tips[p.no].vp, LeftVV[e].vp] THEN {tips[p.no] _ LeftVV[e]}; edges[ix] _ CONS [e, edges[ix]]}; e _ VNext[e] ENDLOOP ENDLOOP END; CookYCoord: PROC [p: Homo.Point] RETURNS [y: REAL] = TRUSTED BEGIN -- Returns the cartesian y-coordinate of p, or plus/minus LasgestNumber (with correct sign) if p is infinite. RETURN [IF Homo.InfPt[p] THEN IF p.y > 0.0 THEN LargestNumber ELSE IF p.y < 0.0 THEN - LargestNumber ELSE 0.0 ELSE p.y/p.w] END; SortChainEdges: INTERNAL PROC [le: EdgeList, fst, lim: NAT, leftTip: REF VVertex] RETURNS [sle: LIST OF REF ANY] = TRUSTED BEGIN OPEN List; -- Sorts the edges of a chain by descending Y, filling the gaps with dummy edges. The chain is assumed to bisect the regions [fst..lim); these parameters are used to figure out whether gaps lie on the left or right boundary of the current region set. -- A Voronoi vertex lies on the left boundary iff it is adjacent to some region with sequence number lim or more. -- The leftTip parameter gives the Voronoi vertex with maximum y on the regions at the left of the chain. It is used as a separator when the chain is empty. DecreasingY: INTERNAL PROC [x: REF ANY, y: REF ANY] RETURNS [Comparison] = TRUSTED {xe: REF Edge = NARROW [x]; ye: REF Edge = NARROW [y]; xlv: Homo.Point = LeftVV[xe].vp; ylv: Homo.Point = LeftVV[ye].vp; RETURN [IF Homo.Below[ylv, xlv] THEN less ELSE IF Homo.Below[xlv, ylv] THEN greater ELSE equal] }; OnLeftBoundary: INTERNAL PROC [v: REF VVertex] RETURNS [is: BOOL] = TRUSTED {e0: REF Edge = v.anEdge; e: REF Edge _ e0; DO IF Dest[e].no > lim THEN RETURN [TRUE]; e _ FNext[e]; IF e = e0 THEN RETURN [FALSE] ENDLOOP }; tle: LIST OF REF ANY _ List.Sort [IsAListOfRefAny[le].list, DecreasingY]; t: LIST OF REF ANY; e: REF Edge; de: REF DummyEdge; lastV: Homo.Point _ [0.0, 1.0, 0.0]; -- y = plus infinity eTop: Homo.Point; sle _ NIL; IF tle = NIL THEN {-- no proper edges in chain - put a dummy edge from top to y separator de _ NEW [DummyEdge _ [topY: CookYCoord[lastV], onLeft: TRUE]]; sle _ CONS[de, sle]; lastV _ leftTip.vp} ELSE {WHILE tle # NIL DO t _ tle; e _ NARROW [t.first]; tle _ t.rest; eTop _ LeftVV[e].vp; IF Homo.Below [eTop, lastV] THEN {-- Found a gap de _ NEW [DummyEdge _ [topY: CookYCoord[lastV], onLeft: OnLeftBoundary[LeftVV[e]]]]; sle _ CONS[de, sle]; lastV _ eTop}; t.rest _ sle; sle _ t; lastV _ RightVV[e].vp; ENDLOOP}; -- Put last dummy edge if needed IF Homo.Below [[0.0, -1.0, 0.0], lastV] THEN {de _ NEW [DummyEdge _ [topY: CookYCoord[lastV], onLeft: FALSE]]; sle _ CONS[de, sle]} END; Error: ERROR [what: ROPE] = CODE; BuildPartialTreeFromChain: INTERNAL PROC [sle: LIST OF REF ANY, ne: NAT, left, right: TreeRoot] RETURNS [root: TreeRoot, chTop: REAL, rest: LIST OF REF ANY] = TRUSTED BEGIN -- Builds a search tree for the first ne edges (including dummy ones) in the sorted -- list sle. The parameters left and right give the roots of the childern chains on -- either side. Returns also the y coordinate chTop of the upper end of the partial chain, -- and the list of unused edges. IF ne = 1 THEN {WITH sle.first SELECT FROM de: REF DummyEdge => {RETURN [root: IF de.onLeft THEN right ELSE left, chTop: de.topY, rest: sle.rest]}; e: REF Edge => {RETURN [root: NEW [EdgeTest _ [edge: e, left: left, right: right]], chTop: CookYCoord[LeftVV[e].vp], rest: sle.rest]}; ENDCASE => ERROR Error["UFO in chain."]} ELSE {up, dn: TreeRoot; dnTop: REAL; [dn, dnTop, sle] _ BuildPartialTreeFromChain [sle, ne/2, left, right]; [up, chTop, rest] _ BuildPartialTreeFromChain [sle, ne - ne/2, left, right]; root _ NEW [YTest _ [testY: dnTop, up: up, dn: dn]]; RETURN} END; TreeData: TYPE = RECORD [root: TreeRoot, tip: REF VVertex]; BuildTreeOfChains: INTERNAL PROC [fst, lim: NAT] RETURNS [rslt: TreeData] = TRUSTED BEGIN -- Builds a Lee-Preparata tree for regions [fst..lim). IF fst+1 = lim THEN {RETURN [[regions[fst], tips[fst]]]} ELSE {rtix: NAT = (fst + lim)/2; left: TreeData = BuildTreeOfChains [fst, rtix]; right: TreeData = BuildTreeOfChains [rtix, lim]; sle: LIST OF REF ANY = SortChainEdges [edges[rtix], fst, lim, left.tip]; ne: NAT = List.Length[sle]; RETURN [[root: BuildPartialTreeFromChain[sle, ne, left.root, right.root].root, tip: IF Homo.Below[right.tip.vp, left.tip.vp] THEN left.tip ELSE right.tip]]} END; SetUpTables[]; RETURN [BuildTreeOfChains [0, n].root] END; ShowEdge: INTERNAL PROC [Diag: REF DelaunayDiagram, e: REF Edge, style: GraphicStyle] = TRUSTED BEGIN vData: ViewerData = NARROW [Diag.viewer.data]; delau:BOOL = vData.showDelaunay; p: REF DVertex = Org[e]; q: REF DVertex = Dest[e]; thing: REF GraphicThing; IF (IF delau THEN Homo.FinPt[p.dp] OR Homo.FinPt [q.dp] ELSE Homo.FinPt[p.dp] AND Homo.FinPt [q.dp]) THEN {thing _ NEW [GraphicThing _ [style: style, obj: NEW [LineSegment _ IF delau THEN [org: Org[e].dp, dest: Dest[e].dp] ELSE [org: LeftVV [e].vp, dest: RightVV [e].vp]] ]]; vData.extraThings _ CONS [thing, vData.extraThings]; ViewerOps.PaintViewer [Diag.viewer, client, FALSE, thing]; Rest[]} END; ShowRegion: INTERNAL PROC [Diag: REF DelaunayDiagram, p: REF DVertex, style: GraphicStyle] = TRUSTED BEGIN vData: ViewerData = NARROW [Diag.viewer.data]; delau:BOOL = vData.showDelaunay; e0, ea: REF Edge; prevInf: BOOL _ TRUE; vs: Polygon _ NIL; thing: REF GraphicThing; IF NOT Homo.FinPt[p.dp] THEN RETURN; thing _ NEW [GraphicThing _ [style: style, obj: NIL]]; e0 _ ea _ p.anEdge; DO IF Homo.FinPt [Dest[ea].dp] THEN {IF prevInf THEN vs _ CONS [RightVV[ea].vp, vs]; vs _ CONS [LeftVV[ea].vp, vs]; prevInf _ FALSE} ELSE {prevInf _ TRUE}; ea _ VNext[ea]; IF ea = e0 THEN EXIT ENDLOOP; thing.obj _ vs; vData.extraThings _ CONS [thing, vData.extraThings]; ViewerOps.PaintViewer [Diag.viewer, client, FALSE, thing]; Rest[] END; ShowPoint: INTERNAL PROC [Diag: REF DelaunayDiagram, pt: Homo.Point, style: GraphicStyle] = TRUSTED BEGIN vData: ViewerData = NARROW [Diag.viewer.data]; thing: REF GraphicThing = NEW [GraphicThing _ [style: style, obj: NEW [Homo.Point _ pt]]]; vData.extraThings _ CONS [thing, vData.extraThings]; ViewerOps.PaintViewer [Diag.viewer, client, FALSE, thing]; Rest[] END; LockAndInsertInVoronoi: ENTRY PROC [newP: Point, Diag: REF DelaunayDiagram] = TRUSTED BEGIN InsertInVoronoi [newP, Diag] END; LockAndSortRegions: ENTRY PROC [Diag: REF DelaunayDiagram] = TRUSTED BEGIN [] _ SortRegions [Diag, TRUE] END; ViewerData: TYPE = REF ViewerDataRec; ViewerDataRec: TYPE = RECORD [Diag: REF DelaunayDiagram, extraThings: LIST OF REF GraphicThing _ NIL, -- extra objects to be painted on viewer live: BOOLEAN _ TRUE, -- so Mother can know when to exit action: REF _ NIL, -- action requested by user (normally an atom from TIP) pt: Cart.Point _ [0.0, 0.0], -- coordinates for moused actions scales: ScalingFactors _ [1.0, 1.0, 1.0, 2.0], -- scaling factors for current Viewer size showDelaunay: BOOLEAN _ TRUE ]; GraphicThing: TYPE = RECORD [style: GraphicStyle, obj: REF -- either Homo.Point, LineSegment, or Polygon. ]; GraphicStyle: TYPE = {thin, normal, bold, boldGray}; LineSegment: TYPE = RECORD [org, dest: Homo.Point]; Polygon: TYPE = LIST OF Homo.Point; ScalingFactors: TYPE = RECORD [orgX, orgY: REAL, -- coordinates of user's origin in Viewer's system scale: REAL, -- multiplies user's units to get Viewer's units scrSize: REAL -- a coordinate that is guaranteed to be outside the Viewer ]; in, out: STREAM; MapPoint: PROC [x, y: REAL, scales: ScalingFactors] RETURNS [xx, yy: REAL] = TRUSTED INLINE BEGIN -- Maps a point from user coordinates to Viewer coordinates OPEN scales; xx _ x*scale + orgX; yy _ y*scale + orgY END; UnmapPoint: PROC [xx, yy: REAL, scales: ScalingFactors] RETURNS [x, y: REAL] = TRUSTED INLINE BEGIN -- Maps a point from Viewer coordinates to user coordinates OPEN scales; x _ (xx - orgX)/scale; y _ (yy - orgY)/scale END; MapHPoint: PROC [p: HPoint, scales: ScalingFactors] RETURNS [xx, yy: REAL] = TRUSTED INLINE BEGIN -- Maps a point from homogeneous user coordinates to Viewer coordinates OPEN scales; s: REAL; IF p.w # 0.0 THEN s _ scale/p.w ELSE {IF p.x = 0.0 AND p.y = 0.0 THEN p.x _ p.y _ 1.0; s _ 20.0*scrSize/MAX [ABS [p.x], ABS [p.y]]}; xx _ p.x*s + orgX; yy _ p.y*s + orgY END; StatusChanged: CONDITION; -- someone screamed for Mother ThrowAPoint: PROC [] RETURNS [p: Point] = TRUSTED BEGIN OPEN Random, Real; p.x _ Float[Next[]]/LAST[INT]; p.y _ Float[Next[]]/LAST[INT]; END; PaintMe: ViewerClasses.PaintProc = TRUSTED BEGIN OPEN Graphics, GraphicsColor; vData: ViewerData _ NARROW[self.data]; PaintPoint: PROC [pt: Homo.Point, style: GraphicStyle] = TRUSTED {IF Homo.FinPt [pt] THEN {ptx: Cart.Point = Homo.Coords [pt]; sz: REAL = (IF style = thin THEN 1.0 ELSE IF style = bold OR style = boldGray THEN 3.0 ELSE 2.0); xx, yy: REAL; [xx, yy] _ MapPoint [pt.x, pt.y, vData.scales]; SetColor[context, IF style = boldGray THEN IntensityToColor[0.5] ELSE black]; DrawBox[context, [xx-sz, yy-sz, xx+sz, yy+sz]] } }; PaintSegment: PROC [org, dest: Homo.Point, style: GraphicStyle] = TRUSTED {wd: REAL = (IF style = thin THEN 0.5 ELSE IF style = bold OR style = boldGray THEN 1.5 ELSE 1.0); xxo, xxd, yyo, yyd: REAL; tx, ty, ts: REAL; [xxo, yyo] _ MapHPoint [org, vData.scales]; [xxd, yyd] _ MapHPoint [dest, vData.scales]; tx _ yyo - yyd; ty _ xxd - xxo; ts _ SqRt [tx*tx + ty*ty]; IF ts > 0.1 THEN {tx _ wd*tx/ts; ty _ wd*ty/ts}; SetColor[context, IF style = boldGray THEN IntensityToColor[0.5] ELSE black]; MoveTo[context, xxo+tx, yyo+ty]; LineTo[context, xxd+tx, yyd+ty]; LineTo[context, xxd-tx, yyd-ty]; LineTo[context, xxo-tx, yyo-ty]; LineTo[context, xxo+tx, yyo+ty]; DrawArea[context] }; PaintPolygon: PROC [pg: Polygon, style: GraphicStyle] = TRUSTED {color: Color = IF style = bold THEN black ELSE IntensityToColor[0.5]; xx, yy: REAL; vs: LIST OF Homo.Point _ pg; fp: BOOL _ TRUE; WHILE vs # NIL DO [xx, yy] _ MapHPoint [vs.first, vData.scales]; IF fp THEN {MoveTo[context, xx, yy]; fp _ FALSE} ELSE {LineTo[context, xx, yy]}; vs _ vs.rest ENDLOOP; SetColor[context, color]; DrawArea[context]; }; PaintThing: PROC [thing: REF GraphicThing] = TRUSTED {WITH thing.obj SELECT FROM rPt: REF Homo.Point => PaintPoint [rPt^, thing.style]; rSeg: REF LineSegment => PaintSegment [rSeg.org, rSeg.dest, thing.style]; rPol: Polygon => PaintPolygon [rPol, thing.style] ENDCASE => {} }; ComputeScales: INTERNAL PROC = TRUSTED BEGIN -- Recomputes vData.scales as adequate for plotting vData.Diag in the current viewer's context. Also resets all 'painted' bits in the data points of Diag, and paints the background. box: Graphics.Box _ Graphics.GetBounds[context]; oldScales: ScalingFactors = vData.scales; xymx: REAL _ 1.0; maxX: REAL _ box.xmax; maxY: REAL _ box.ymax; minX: REAL _ box.xmin; minY: REAL _ box.ymin; halfX: REAL _ (maxX - minX) / 2.0; halfY: REAL _ (maxY - minY) / 2.0; figSize: REAL _ MIN [maxY - minY, maxX - minX]*0.8; pts: DVertexList _ vData.Diag.points; pt: Cart.Point; -- sweeps through data points, computing scale factors and resetting marks WHILE pts # NIL DO pts.first.painted _ FALSE; IF Homo.FinPt [pts.first.dp] THEN {pt _ Homo.Coords[pts.first.dp]; xymx_MAX[xymx,ABS[pt.x]]; xymx_MAX[xymx,ABS[pt.y]]}; pts _ pts.rest ENDLOOP; vData.scales _ [orgX: halfX, orgY: halfY, scale: figSize/xymx/2.0, scrSize: MAX [halfX, halfY]]; -- paint background SetColor[context, Graphics.white]; DrawBox[context, box]; END; RePaintDiagram: ENTRY PROC = TRUSTED BEGIN pts: DVertexList; p, q: REF DVertex; ea, e0: REF Edge; ist: LIST OF REF GraphicThing; oldPriority: Process.Priority _ Process.GetPriority[]; Process.SetPriority[Process.priorityBackground]; -- recompute scale factors (in case Viewer size has changed) and reset the marks ComputeScales []; -- highlight the Polygons in extraThings ist _ vData.extraThings; WHILE ist # NIL DO IF ISTYPE [ist.first.obj, REF Polygon] THEN PaintThing [ist.first]; ist _ ist.rest ENDLOOP; -- draw the edges and data points of the Voronoi pts _ vData.Diag.points; SetColor[context, black]; WHILE pts # NIL DO p _ pts.first; pts _ pts.rest; -- enumerate outgoing edges e0 _ ea _ p.anEdge; DO q _ Dest[ea]; IF NOT q.painted THEN {IF vData.showDelaunay AND (Homo.FinPt[p.dp] OR Homo.FinPt [q.dp]) THEN {PaintSegment [p.dp, q.dp, normal]} ELSE IF NOT vData.showDelaunay AND (Homo.FinPt[p.dp] AND Homo.FinPt [q.dp]) THEN {PaintSegment [LeftVV[ea].vp, RightVV[ea].vp, normal]} }; ea _ VNext [ea]; IF ea = e0 THEN EXIT ENDLOOP; PaintPoint [p.dp, normal]; p.painted _ TRUE ENDLOOP; -- paint the points and segements in extraThings ist _ vData.extraThings; WHILE ist # NIL DO PaintThing [ist.first]; ist _ ist.rest ENDLOOP; Process.SetPriority[oldPriority] END; IF NOT vData.live THEN RETURN; -- analyze and process cause of call IF whatChanged = NIL THEN {RePaintDiagram []} ELSE {-- must be a new GraphicThing that has just been added to the extraThings -- there is a small chance of a race here: if the Window Manager has relocated -- the viewer but the corresponding call of PaintViewer has not been -- initiated, the old scale factors will be used. thing: REF GraphicThing = NARROW [whatChanged]; PaintThing[thing]}; END; DestroyMe: ViewerClasses.DestroyProc = TRUSTED BEGIN -- parameters: [self: Viewer] vData: ViewerData _ NARROW[self.data]; vData.live _ FALSE; TellMother[] END; InitMe: ViewerClasses.InitProc = TRUSTED BEGIN -- parameters: [self: Viewer] out.PutF["Called InitMe...\n"] END; ShowDualOfMe: Menus.MenuProc = TRUSTED BEGIN -- parameters: [viewer: Viewer, clientData: REF ANY, redButton: BOOL] vData: ViewerData _ NARROW [viewer.data]; out.PutF["Called ShowDualOfMe...\n"]; vData.showDelaunay _ NOT vData.showDelaunay; vData.action _ $Repaint; TellMother[] END; SortMe: Menus.MenuProc = TRUSTED BEGIN -- parameters: [viewer: Viewer, clientData: REF ANY, redButton: BOOL] vData: ViewerData _ NARROW [viewer.data]; out.PutF["Called SortMe...\n"]; vData.action _ $Sort; TellMother[] END; ThrowMe: Menus.MenuProc = TRUSTED BEGIN -- parameters: [viewer: Viewer, clientData: REF ANY, redButton: BOOL] vData: ViewerData _ NARROW [viewer.data]; out.PutF["Called ThrowMe...\n"]; vData.action _ $Throw; TellMother[] END; TipMe: ViewerClasses.NotifyProc = TRUSTED BEGIN -- parameters [self: Viewer, input: LIST OF REF ANY] -- N.B. Called at Process.priorityForeground! -- we have conspired to make the leading item in the list -- an atom that tells us what to do with the rest of the list IF input # NIL AND input.rest # NIL AND (input.first = $LeftDown OR input.first = $CenterDown OR input.first = $RightDown) THEN {vData: ViewerData = NARROW[self.data]; coord: TIPTables.TIPScreenCoords _ NARROW[input.rest.first, TIPTables.TIPScreenCoords]; vData.action _ input.first; [vData.pt.x, vData.pt.y] _ UnmapPoint [coord.mouseX, coord.mouseY, vData.scales]; TellMother []} END; TellMother: ENTRY PROC = TRUSTED {BROADCAST StatusChanged}; WaitStatusChanged: ENTRY PROC = TRUSTED {WAIT StatusChanged}; MakeMenu: PROC RETURNS [m: Menus.Menu] = TRUSTED BEGIN -- creates the menu -- the leftmost 4 entries are in standard order m _ Menus.CreateMenu[]; Menus.AppendMenuEntry[menu: m, name: "Close", proc: ViewerMenus.Close]; Menus.AppendMenuEntry[menu: m, name: "Grow", proc: ViewerMenus.Grow]; Menus.AppendMenuEntry[menu: m, name: "<-->", proc: ViewerMenus.Move]; Menus.AppendMenuEntry[menu: m, name: "Quit", proc: ViewerMenus.Destroy, fork: TRUE]; Menus.AppendMenuEntry[menu: m, name: "Dual", proc: ShowDualOfMe]; Menus.AppendMenuEntry[menu: m, name: "Sort", proc: SortMe]; Menus.AppendMenuEntry[menu: m, name: "Throw", proc: ThrowMe] END; MakeDelaunay: ENTRY PROC RETURNS [Diag: REF DelaunayDiagram] = TRUSTED BEGIN -- returns a new Delaunay diagram with only three dummy vData points -- at the Mercedes infinities. sqrt3: REAL = SqRt[3.0]; pi1: REF DVertex = NEW [DVertex _ [dp: [0.0, sqrt3/3.0, 0.0], no: -1, anEdge: NIL]]; pi2: REF DVertex = NEW [DVertex _ [dp: [-0.5, -sqrt3/6.0, 0.0], no: -2, anEdge: NIL]]; pi3: REF DVertex = NEW [DVertex _ [dp: [0.5, -sqrt3/6.0, 0.0], no: -3, anEdge: NIL]]; v123: REF VVertex = NEW [VVertex _ [vp: [0.0, 0.0, 1.0], anEdge: NIL]]; v321: REF VVertex = NEW [VVertex _ [vp: [0.0, 0.0, 0.0], anEdge: NIL]]; e12: REF Edge = ConnectPoints [pi1, pi2, NIL, NIL, v123, v321]; e23: REF Edge = ConnectPoints [pi2, pi3, e12.sym, NIL, v123, v321]; e31: REF Edge = ConnectPoints [pi3, pi1, e23.sym, e12, v123, v321]; nDV _ 0; RETURN [NEW [DelaunayDiagram _ [points: LIST [pi1, pi2, pi3], viewer: NIL]]] END; MakeViewer: PROC RETURNS [viewer: ViewerClasses.Viewer] = TRUSTED BEGIN -- creates the viewer tipTable: TIPUser.TIPTable _ TIPUser.InstantiateNewTIPTable["COG.tip"]; viewerClass: ViewerClasses.ViewerClass _ NEW [ViewerClasses.ViewerClassRec _ [paint: PaintMe, -- called whenever the Viewer should repaint notify: TipMe, -- TIP input events modify: NIL, -- InputFocus changes reported through here destroy: DestroyMe, -- called before Viewer structures freed on destroy op copy: NIL, -- copy data to new Viewer set: NIL, -- set the viewer contents get: NIL, -- get the viewer contents init: InitMe, -- called on creation or reset to init data save: NIL, -- requests client to write contents to disk scroll: NIL, -- document scrolling icon: document, -- picture to display when small tipTable: tipTable, -- could be moved into Viewer instance if needed cursor: crossHairsCircle -- standard cursor when mouse is in viewer ]]; menu: Menus.Menu _ MakeMenu[]; Diag: REF DelaunayDiagram; vData: ViewerData; out.PutF["Registering Viewer Class...\n"]; ViewerOps.RegisterViewerClass[$VoroPlotter, viewerClass]; out.PutF["Initializing the Voronoi...\n"]; Diag _ MakeDelaunay[]; vData _ NEW[ViewerDataRec _ [Diag: Diag]]; out.PutF["Creating Viewer...\n"]; viewer _ Diag.viewer _ ViewerOps.CreateViewer [flavor: $VoroPlotter, info: [menu: menu, name: "Voronoi Diagram", column: left, iconic: FALSE, data: vData], paint: TRUE] END; Mother: PROC [viewer: ViewerClasses.Viewer] = TRUSTED BEGIN ENABLE ABORTED => GO TO bye; vData: ViewerData _ NARROW [viewer.data]; WHILE TRUE DO WaitStatusChanged; IF NOT vData.live THEN GO TO bye; vData.extraThings _ NIL; ViewerOps.PaintViewer [viewer, client, FALSE, NIL]; IF vData.action = $LeftDown THEN {LockAndInsertInVoronoi[vData.pt, vData.Diag]} ELSE IF vData.action = $RightDown THEN {out.PutF["Sorry, can't delete yet.\n"]} ELSE IF vData.action = $Repaint THEN {} ELSE IF vData.action = $Sort THEN {LockAndSortRegions [vData.Diag]} ELSE IF vData.action = $Throw THEN {n: NAT; out.PutF ["How many points? "]; n _ in.GetInt[]; out.PutF["\n"]; THROUGH [1..n] DO LockAndInsertInVoronoi [ThrowAPoint [], vData.Diag] ENDLOOP; }; vData.action _ NIL ENDLOOP; EXITS bye => {Close[in]; Close[out]}; END; Rest: PROC = TRUSTED {Process.Pause[Process.MsecToTicks[300]]}; [in,out] _ CreateTTYStreams["Voronoi.TTY"]; [] _ Random.Init[,-1]; out.PutF["Hello!\n"]; Process.Detach[FORK Mother[MakeViewer[]]] END. �-- COGVoronoi.mesa: test bed for various Voronoi algorithms -- last modified by Stolfi August 17, 1982 7:42 pm -- To do: debug ShowRegion - sometimes shows complement of (infinite) region instead of region -- To do: Throw: repaint diagram after each point -- To do: Throw: use a better range (now is astronomical) -- To do: Repaint and Reset commands -- To do: Make of it a "Geometrical Viewer module" -- To do: check locking scheme -- compile COGVoronoi -- to run: -- run RandomImpl -- run COGHomoImpl -- run COGCartImpl -- run COGVoronoi -- BASIC OPERATIONS ON DELAUNAY DIAGRAMS - - - - - - - - - - - - - - - - - - - - - - - - -- POINT INSERTION - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- LEFT-TO-RIGHT SORT OF VORONOI REGIONS - - - - - - - - - - - - - - - - - - - - - - - - - -- THE LEE-PREPARATA ALGORITHM - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- The Lee-Preparata structure is a binary search tree, whose leaves are the Voronoi regions and whose internal nodes are monotone chains of Voronoi edges. Each chain is by itself a binary search tree: the nodes of the latter are of two kinds, called YTests and EdgeTests. -- YTest nodes branch depending on whether the query point q is above or below the testY field. When an EdgeTest is encountered, q.y is known to be between those of the edge endpoints; that being the case, q.x can be tested against the edge. -- A node of either kind has two pointers, which can refer to Voronoi regions (ultimate leaves), to its children in the same chain C, or to the roots of the chains that are children of C in the global tree. The latter is always the case for EdgeTests, and sometimes also for the YTests. The latter case occurs when the edge of C that covers q.y belongs also to some ancestor C' of C. At this point, we know on which side of C' the query point q lies, and therefore we do not have to test it again against that edge; we can proceed immediately to the root of the appropriate descendant chain C'' of C. -- INTERNAL PROCEDURES FOR DISPLAYING EXTRA THINGS ON VIEWER - - - - - - - - - - - -- ENTRY PROCEDURES FOR DELAUNAY DIAGRAM - - - - - - - - - - - - - - - - - - - - - - - -- VIEWER PROCEDURES - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- Parameters: [self: Viewer, context: Graphics.Context, whatChanged: REF ANY] -- If cause is a REF GraphicThing, the caller may be holding the monitor lock. Must avoid looking at the Delaunay diagram in that case. ��[�"Mesa" style�Iproc��c�bc�)�;��2�2K��b�V�^K��)�1K��1�9K��$K��*�2K��K��K��T�]K� �k ��t��z�� 1��?��>��!��>��q��)��K�� .��A� ��+��K�K��W��ZK�� -��8� ��8� �� A��K�K��K��K��4�� $��A� ��/��K��@��K��4� ��!��K� ��"K� �� (K��,��K�K��Y�Y� �n�� JK�� JK�� JK�� JK�� KK�� JK�� NK�� OK�� \K��)��7�� zK�4��R��A��H�<��I��a�� @��]��6��d��@�� 1K�&��-��Y��:��B�� nK�"��6��3��2�� G��'��9��K�K��e�eK��0�;� ��QK�n��C��=��2��!��4��5��(��\� ��@�N��!��'��"�� :�0�� :��a��+��J��O��D��!��K�K��[�[�� xK��S��X��Y��[��_��b��<�� M��=�"��R��J��F��u�� a��?�� 9��0��:�S�� O��F��3�� /��R��)��I��%�� <��K��\�\K��K��;��E��J�� K��K��#��eK�� #��pK� ��<�V��qK��>�� F�� bn ��:K�(��W��A�� !�� @K��W�� K�5��7�� !��/� �� %� �� )��)�� &K�6��T��J��D��2�(��?��'��V�� 1��)��;��*�� @K��n�� K�� r�� Z�� !�� ;�� 3��G��N��,��?��|��j��!��&��N��K� ��$�� !��K�2��T��V��]��#�� R��&��1��K� �� >� �� [K�"��7�� >��_��'�� K��!��?�K�K��R�R��cK�*��$��<��3��V��N�� !��hK�>��!��%�� #��'�� *��K�� 9��eK��%��,��K��K�K��V�V� ��VK�� )�� DK��*�K�K��^�^K�� %K�&� ��$��)��#� ��8�"�"�4�+��K� ��%��/��zK��"�4K��7K�� $K��3��1��<��K�� [K��<��6�� ]K��<��:�� %�� [K��H��.��3��K�� 8��1K�� _��*��#K��N�NK��K��&�� )��@K��1�� L��E��0��IK�� 4��&��?K�!��!��8��#��3��4�� 4K� �� 8��x�� &��K�/��b��!��Y�K��8��l��=��K��$K�^�� ~�Q��)�� 3��1�6��(��4��$��^�� 1��1��3��&�� K��%��J��O��G��4� ��&��K�� /K� ��x��(K��!��K��&K� ��F��O��?�� K��F��Y��!K��F��[��)K� ��5��/��:��>�� !��#��5��K� � �� ;K� ��=��1K� ��0��FK�<��E�� 8��:��9��*��*��!��*��I��"�� #��BK�6��u��@�-��,��7�� ,��-�� !��1�!�+�4��5��"��5K�N��-��;��5��.��[��H��!��#��K��+�AK��s��K