ControlsContourmpl.mesa
Copyright Ó 1985, 1992 by Xerox Corporation. All rights reserved.
Bloomenthal, July 2, 1992 6:09 pm PDT
DIRECTORY Controls, ControlsPrivate, Draw2d, Real, ViewerClasses, ViewerOps;
ControlsContourImpl: CEDAR PROGRAM
IMPORTS ControlsPrivate, Draw2d, Real, ViewerOps
EXPORTS Controls, ControlsPrivate
~ BEGIN
Types
Control:      TYPE ~ Controls.Control;
IntegerPair:     TYPE ~ Controls.IntegerPair;
IntegerPairSequence:  TYPE ~ Controls.IntegerPairSequence;
IntegerPairSequenceRep: TYPE ~ Controls.IntegerPairSequenceRep;
Mouse:      TYPE ~ Controls.Mouse;
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:       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
];
Notes
Possibly the run structure should be replaced with a linked list of pairs so AddPoint would be:
pair: REF IntegerPair ← NEW[IntegerPair];
pair.next ← nearestIntegerPair.next;
nearestIntegerPair.next ← NEW[IntegerPair];
This would simplify the code (especially if NearestIntegerPair 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[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];
};
};
Contour To/From Controls
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];
};
};
Contour Notification
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;
chain.drawing ← TRUE;
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;
};
Contour Painting
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];
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"];
};
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];
Status[];
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]]};
chain.drawing ← FALSE;
};
Contour Processing
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.
..
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;
};
};