<<>> <> <> <> DIRECTORY Controls, ControlsPrivate, Draw2d, Real, ViewerClasses, ViewerOps; ControlsContourImpl: CEDAR PROGRAM IMPORTS ControlsPrivate, Draw2d, Real, ViewerOps EXPORTS Controls, ControlsPrivate ~ BEGIN <> Control: TYPE ~ Controls.Control; IntegerPair: TYPE ~ Controls.IntegerPair; IntegerPairSequence: TYPE ~ Controls.IntegerPairSequence; IntegerPairSequenceRep: TYPE ~ Controls.IntegerPairSequenceRep; Mouse: TYPE ~ Controls.Mouse; <> 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: IntegerPairSequence ¬ 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[IntegerPairSequenceRep[10000]]; -- usually large enough chain.chainStart ¬ NEW[RunRep]; }; 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 RequestPaint[control, FALSE, NIL]; }; }; <> GetContour: PUBLIC PROC [control: Control] RETURNS [pairs: IntegerPairSequence] ~ { IF control.type = contour THEN { chain: Chain ¬ NARROW[control.contourRef]; nIntegerPairs: INTEGER ¬ NPointsInContour[control]; n: INTEGER ¬ 0; start: Run ¬ chain.chainStart; run: Run ¬ start; IF nIntegerPairs = 0 THEN RETURN[NIL]; pairs ¬ NEW[IntegerPairSequenceRep[nIntegerPairs]]; pairs.length ¬ nIntegerPairs; 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; }; }; SetContour: PUBLIC PROC [ control: Control, pairs: IntegerPairSequence, closed: BOOL ¬ FALSE, repaint: BOOL ¬ TRUE] ~ { IF control.type = contour THEN { chain: Chain ¬ NARROW[control.contourRef]; IF pairs = NIL THEN RETURN; chain.closed ¬ closed; chain.splicing ¬ FALSE; chain.pairs ¬ pairs; chain.p0 ¬ MAX[0, NAT[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 RequestPaint[control, FALSE, NIL]; }; }; <> NotifyContour: PUBLIC PROC [control: Control, mouse: Mouse] ~ { whatChanged: REF ANY ¬ control; chain: Chain ¬ NARROW[control.contourRef]; control.mouse ¬ mouse; IF mouse.button # left -- OR chain.drawing -- THEN RETURN; <> SELECT mouse.state FROM down => { AddIntegerPair[chain, mouse.pos]; chain.runStart ¬ chain.p1; IF chain.p1 # 0 THEN { chain.splice0 ¬ NearestIntegerPair[chain, mouse.pos]; chain.p0 ¬ chain.splice0.n; IF chain.closed OR chain.p0 # chain.p1-1 THEN chain.splicing ¬ TRUE; }; }; held => { AddIntegerPair[chain, mouse.pos]; 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 ¬ NearestIntegerPair[chain, chain.pairs[chain.p1]]; InsertSplice[chain]; } ELSE chain.chainStart.stop ¬ chain.p1; }; ENDCASE => NULL; RequestPaint[control, 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: IntegerPair ¬ chain.pairs[chain.chainStart.start]; p1: IntegerPair ¬ chain.pairs[chain.p1]; dx: INTEGER ¬ p1.x-p0.x; dy: INTEGER ¬ p1.y-p0.y; RETURN[dx*dx+dy*dy]; }; AddIntegerPair: PROC [chain: Chain, pair: IntegerPair] ~ { pairs: IntegerPairSequence ¬ chain.pairs; IF pairs.length = pairs.maxLength THEN pairs ¬ chain.pairs ¬ LengthenIntegerPairSequence[pairs]; pairs[pairs.length] ¬ pair; chain.p1 ¬ pairs.length; pairs.length ¬ pairs.length+1; }; LengthenIntegerPairSequence: PUBLIC PROC [integerPairs: IntegerPairSequence, amount: REAL ¬ 1.3] RETURNS [new: IntegerPairSequence] ~ { newLength: NAT ¬ MAX[Real.Round[amount*integerPairs.length], 3]; new ¬ NEW[IntegerPairSequenceRep[newLength]]; FOR i: NAT IN [0..integerPairs.length) DO new[i] ¬ integerPairs[i]; ENDLOOP; new.length ¬ integerPairs.length; }; 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; }; NearestIntegerPair: PROC [chain: Chain, pair: IntegerPair] RETURNS [splice: Splice] ~ { max: REAL ¬ 100000.0; pairs: IntegerPairSequence ¬ 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; }; <> RequestPaint: PROC [control: Control, clearClient: BOOL, whatChanged: REF ANY] ~ { ViewerOps.PaintViewer[control.viewer, client, clearClient, whatChanged]; }; PaintContour: PUBLIC ViewerClasses.PaintProc ~ { control: Control ¬ NARROW[self.data]; chain: Chain ¬ NARROW[control.contourRef]; <> <> <> <> <> <> <<};>> <> <> <> <<};>> Line: PROC [p0, p1: IntegerPair] ~ {Draw2d.Line[context, [p0.x, p0.y], [p1.x, p1.y]]}; ChainReDraw: PROC ~ { pairs: IntegerPairSequence ¬ chain.pairs; start: Run ¬ chain.chainStart; run: Run ¬ start; Draw2d.Clear[context]; <> DO FOR n: NAT IN [run.start..run.stop) DO Line[pairs[n], pairs[n+1]]; ENDLOOP; IF run.next # NIL THEN Line[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, FALSE] ELSE {--Status[];-- Line[chain.pairs[chain.p0], chain.pairs[chain.p1]]}; <> }; <> CloseContour: PUBLIC PROC [control: Control, repaint: BOOL ¬ TRUE] ~ { IF control.contourRef # NIL THEN { CloseChain[NARROW[control.contourRef]]; IF repaint THEN RequestPaint[control, 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]; nIntegerPairs: 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 nIntegerPairs ¬ nIntegerPairs+run.stop-run.start+1; run ¬ run.next; IF run = start OR run = NIL THEN EXIT; ENDLOOP; RETURN[nIntegerPairs]; }; }; END. .. <> < s0.n>> <> <> <> <> <<>> <> <> <> <> <> <> <<};>> <<};>> <<>>