<> <> <> DIRECTORY Controls, ControlsPrivate, Draw2d, ViewerClasses, ViewerOps; ControlsContourImpl: CEDAR PROGRAM IMPORTS ControlsPrivate, Draw2d, ViewerOps EXPORTS Controls, ControlsPrivate ~ BEGIN OPEN Controls; <> Chain: TYPE ~ REF ChainRep; ChainRep: TYPE ~ RECORD [ runStart: INTEGER _ 0, -- start of current run p0, p1: INTEGER _ 0, -- current line segment to draw splice0, splice1: Splice, -- splice points for current run chainStart: Run _ NIL, -- starting run of chain pairs: PosSequence _ NIL, -- chain points splicing: BOOL _ FALSE, -- splicing an insert, or just 1st draw? closed: BOOL _ FALSE, -- loop closed? drawing: BOOL _ FALSE -- speed trap for notify proc ]; Splice: TYPE ~ RECORD [ run: Run _ NIL, n: INTEGER _ 0 ]; Run: TYPE ~ REF RunRep; RunRep: TYPE ~ RECORD [ start: INTEGER _ 0, -- pairs index for start of run (inclusive) stop: INTEGER _ 0, -- pairs index for stop of run (inclusive) next: Run _ NIL ]; <> <> <> <> <> <> <> <> NewContour: PUBLIC PROC [control: Control] ~ { chain: Chain _ NEW[ChainRep]; control.contourRef _ chain; chain.pairs _ NEW[PosSequenceRep[10000]]; -- usually large enough chain.chainStart _ NEW[RunRep]; }; EnlargePosSequence: PROC [old: PosSequence] RETURNS [PosSequence] ~ { <> new: PosSequence _ NIL; IF old # NIL THEN { new _ NEW[PosSequenceRep[2*old.maxLength]]; FOR n: NAT IN [0..old.length) DO new[n] _ old[n]; ENDLOOP; new.length _ old.length; }; RETURN[new]; }; ClearContour: PUBLIC PROC [control: Control, repaint: BOOL _ TRUE] ~ { IF control.type = contour THEN { chain: Chain _ NARROW[control.contourRef]; newChain: Chain _ NEW[ChainRep _ [pairs: chain.pairs]]; chain.pairs.length _ 0; control.contourRef _ newChain; newChain.chainStart _ NEW[RunRep]; IF repaint THEN ViewerOps.PaintViewer[control.viewer, client, FALSE, NIL]; }; }; <> NotifyContour: PUBLIC PROC [control: Control] ~ { whatChanged: REF ANY _ control; mouse: Mouse _ control.mouse; mousePos: Pos _ [mouse.x, mouse.y]; chain: Chain _ NARROW[control.contourRef]; IF mouse.button # left -- OR chain.drawing -- THEN RETURN; <> SELECT mouse.state FROM down => { AddPos[chain, mousePos]; chain.runStart _ chain.p1; IF chain.p1 # 0 THEN { chain.splice0 _ NearestPos[chain, mousePos]; chain.p0 _ chain.splice0.n; IF chain.closed OR chain.p0 # chain.p1-1 THEN chain.splicing _ TRUE; }; }; held => { AddPos[chain, mousePos]; chain.p0 _ MAX[0, chain.p1-1]; }; up => { IF NOT chain.closed AND CloseEnough[chain] IN [1..30] -- AND chain.p1 # 0 -- THEN { CloseChain[chain]; whatChanged _ NIL; }; IF chain.splicing THEN { whatChanged _ NIL; chain.splice1 _ NearestPos[chain, chain.pairs[chain.p1]]; InsertSplice[chain]; } ELSE chain.chainStart.stop _ chain.p1; }; ENDCASE => NULL; ViewerOps.PaintViewer[control.viewer, client, FALSE, whatChanged]; IF mouse.state = up THEN ControlsPrivate.MaybeForkControlProc[control]; }; CloseChain: PROC [chain: Chain] ~ { chain.closed _ TRUE; IF chain.chainStart.next = NIL THEN chain.chainStart.next _ chain.chainStart ELSE { run: Run _ chain.chainStart.next; WHILE run # chain.chainStart AND run.next # NIL DO run _ run.next; ENDLOOP; run.next _ chain.chainStart; }; }; CloseEnough: PROC [chain: Chain] RETURNS [INTEGER] ~ { p0: Pos _ chain.pairs[chain.chainStart.start]; p1: Pos _ chain.pairs[chain.p1]; dx: INTEGER _ p1.x-p0.x; dy: INTEGER _ p1.y-p0.y; RETURN[dx*dx+dy*dy]; }; AddPos: PROC [chain: Chain, pair: Pos] ~ { pairs: PosSequence _ chain.pairs; IF pairs.length = pairs.maxLength THEN pairs _ chain.pairs _ EnlargePosSequence[pairs]; pairs[pairs.length] _ pair; chain.p1 _ pairs.length; pairs.length _ pairs.length+1; }; InsertSplice: PROC [chain: Chain] ~ { IsClosed: PROC [start: Run] RETURNS [BOOL] ~ { FOR run: Run _ start.next, run.next WHILE run # NIL DO IF run = start THEN RETURN[TRUE]; ENDLOOP; RETURN[FALSE]; }; s0: Splice _ chain.splice0; s1: Splice _ chain.splice1; run0: Run _ s0.run; run1: Run _ s1.run; run: Run _ NEW[RunRep]; IF run0 = run1 THEN run1 _ NEW[RunRep _ run0^]; run0.next _ run; run.next _ run1; run0.stop _ s0.n; run.start _ chain.runStart; run.stop _ chain.p1; run1.start _ s1.n; IF NOT chain.closed THEN chain.closed _ IsClosed[run0]; IF chain.closed THEN chain.chainStart _ run; }; NearestPos: PROC [chain: Chain, pair: Pos] RETURNS [splice: Splice] ~ { max: REAL _ 100000.0; pairs: PosSequence _ chain.pairs; start: Run _ chain.chainStart; run: Run _ start; IF run # NIL THEN DO FOR n: NAT IN [run.start..run.stop] DO dx: REAL _ pair.x-pairs[n].x; dy: REAL _ pair.y-pairs[n].y; m: REAL _ dx*dx+dy*dy; IF m < max THEN { splice _ [run, n]; max _ m; }; ENDLOOP; run _ run.next; IF run = start OR run = NIL THEN EXIT; ENDLOOP; }; <> PaintContour: PUBLIC ViewerClasses.PaintProc ~ { control: Control _ NARROW[self.data]; chain: Chain _ NARROW[control.contourRef]; <> <> <> <> <> <> <<};>> <> <> <> <<};>> LinePos: PROC [p0, p1: Pos] ~ {Draw2d.Line[context, [p0.x, p0.y], [p1.x, p1.y]]}; ChainReDraw: PROC ~ { pairs: PosSequence _ chain.pairs; start: Run _ chain.chainStart; run: Run _ start; Draw2d.Clear[context]; <> DO FOR n: NAT IN [run.start..run.stop) DO LinePos[pairs[n], pairs[n+1]]; ENDLOOP; IF run.next # NIL THEN LinePos[pairs[run.stop], pairs[run.next.start]]; IF run.next = start THEN EXIT; run _ run.next; IF run = start OR run = NIL THEN EXIT; ENDLOOP; }; IF chain = NIL THEN RETURN; IF whatChanged = NIL THEN Draw2d.DoWithBuffer[context, ChainReDraw] ELSE {--Status[];-- LinePos[chain.pairs[chain.p0], chain.pairs[chain.p1]]}; <> }; <> GetContour: PUBLIC PROC [control: Control] RETURNS [PosSequence] ~ { chain: Chain _ NARROW[control.contourRef]; pairs: PosSequence; nPoss: INTEGER _ NPointsInContour[control]; n: INTEGER _ 0; start: Run _ chain.chainStart; run: Run _ start; IF nPoss = 0 THEN RETURN[NIL]; pairs _ NEW[PosSequenceRep[nPoss]]; pairs.length _ nPoss; run _ start; DO FOR r: NAT IN [run.start..run.stop] DO pairs[n] _ chain.pairs[r]; n _ n+1; ENDLOOP; run _ run.next; IF run = start OR run = NIL THEN EXIT; ENDLOOP; RETURN[pairs]; }; SetContour: PUBLIC PROC [ control: Control, pairs: PosSequence, closed: BOOL _ FALSE, repaint: BOOL _ TRUE] ~ { chain: Chain _ NARROW[control.contourRef]; IF pairs = NIL THEN RETURN; chain.closed _ closed; chain.splicing _ FALSE; chain.pairs _ pairs; chain.p0 _ MAX[0, chain.pairs.length-1]; chain.chainStart _ NEW[RunRep _ [0, pairs.length-1, NIL]]; IF chain.closed THEN chain.chainStart.next _ chain.chainStart; IF repaint THEN ViewerOps.PaintViewer[control.viewer, client, FALSE, NIL]; }; CloseContour: PUBLIC PROC [control: Control, repaint: BOOL _ TRUE] ~ { IF control.contourRef # NIL THEN { CloseChain[NARROW[control.contourRef]]; IF repaint THEN ViewerOps.PaintViewer[control.viewer, client, FALSE, NIL]; }; }; IsContourClosed: PUBLIC PROC [control: Control] RETURNS [BOOL] ~ { RETURN[IF control.contourRef = NIL THEN FALSE ELSE NARROW[control.contourRef, Chain].closed]; }; NPointsInContour: PUBLIC PROC [control: Control] RETURNS [INTEGER] ~ { IF control.contourRef = NIL THEN RETURN[0] ELSE { chain: Chain _ NARROW[control.contourRef]; nPoss: INTEGER _ 0; start: Run _ chain.chainStart; run: Run _ start; IF (run.next = start OR run.next = NIL) AND run.start = run.stop THEN RETURN[0]; DO nPoss _ nPoss+run.stop-run.start+1; run _ run.next; IF run = start OR run = NIL THEN EXIT; ENDLOOP; RETURN[nPoss]; }; }; END. .. <> < s0.n>> <> <> <> <> <<>> <> <> <> <> <> <> <<};>> <<};>> <<>>