ControlsContourmpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Bloomenthal, October 8, 1986 9:55:25 pm PDT
DIRECTORY Controls, ControlsPrivate, Draw2d, ViewerClasses, ViewerOps;
ControlsContourImpl: CEDAR PROGRAM
IMPORTS ControlsPrivate, Draw2d, ViewerOps
EXPORTS Controls, ControlsPrivate
~ BEGIN
OPEN Controls;
Contour Definitions
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
];
Notes
Possibly the run structure should be replaced with a linked list of pairs so AddPoint would be:
pair: REF Pos ← NEW[Pos];
pair.next ← nearestPos.next;
nearestPos.next ← NEW[Pos];
This would simplify the code (especially if NearestPos is to return a point in the middle of a
long segment) though maybe reduce performance.
Contour Initialization/Clearing
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] ~ {
This is a gross, but simple, solution.
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];
};
};
Contour Notification
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;
chain.drawing ← TRUE;
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;
};
Contour Painting
PaintContour: PUBLIC ViewerClasses.PaintProc ~ {
control: Control ← NARROW[self.data];
chain: Chain ← NARROW[control.contourRef];
Status: PROC ~ {
Line: PROC [line: NAT, rope: ROPE] ~ {
Imager.SetColor[context, Imager.white];
Imager.MaskReptangleI[context, 0, 13*line, 160, 10];
Imager.SetColor[context, Imager.black];
Draw2d.Label[context, [0, 13*line], rope];
};
Line[0, IO.PutFR["p0 = %g, p1 = %g", IO.int[chain.p0], IO.int[chain.p1]]];
Line[1, IO.PutFR["chain.splice0.n = %g", IO.int[chain.splice0.n]]];
Line[2, IF chain.splicing THEN "splicing" ELSE "not splicing"];
};
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];
Status[];
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]]};
chain.drawing ← FALSE;
};
Contour Processing
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.
..
NPossWithin: PROC [chain: Chain, s0, s1: Splice] RETURNS [nPoss: INTEGER] ~ {
IF s0.run = s1.run AND s1.n > s0.n
THEN nPoss ← s1.n-s0.n+1
ELSE {
run: Run ← s0.run.next;
nPoss ← (s0.run.stop-s0.n+1)+(s1.n-s1.run.start+1);
DO
IF run = NIL THEN run ← chain.chainStart;
IF run = s1.run THEN EXIT;
nPoss ← nPoss+run.stop-run.start+1;
run ← run.next;
ENDLOOP;
};
};