
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.
..


   ъ  
ControlsContourmpl.mesa
Copyright ╙ 1985, 1992 by Xerox Corporation.  All rights reserved.
Bloomenthal, July 2, 1992 6:09 pm PDT
Types
Contour Definitions
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
Contour To/From Controls
Contour Notification
chain.drawing _ TRUE;
Contour Painting
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"];
};
Status[];
chain.drawing _ FALSE;
Contour Processing
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;
};
};

Э╩Ї  ХNewlineDelimiter
Ц"cedarcode" styleЩ ЪЬЩJЪЬ	╧eЬ6ЩBJЩ%JШ JЪ╧k	ЬCШLJШ ЧЪ╨blЬЮЬЮШ"JЪЮЬ)Ш0ЪЮЬШ!JШ ЧЧJЪЬЮШheadЪ╧lЩJЪЬ
ЮЬШ&JЪЬЮЬШ-JЪЬЮЬ Ш:JЪЬЮЬ#Ш?JЪЬЮ	ЬШ"ЧЪаЩJЪЬЮЬЮЬ
ШЪЬЮЬЮЬШJЪЬЮЬ╧cШ5JЪЬЮЬбШ;JЪЬ!б ШAJЪЬЮЬбШ6JЪЬ#ЮЬбШ7JЪЬЮЬЮЬб(ШGJЪЬЮЬЮЬбШ,JЪЬЮЬЮЬбШ:JШЧJШ ЪЬЮЬЮЬШJЪЬЮЬШJЪЬ
ЮЬШJШJШ ЧJЪЬ	ЮЬЮЬШЪЬ
ЮЬЮЬШJЪЬЮЬб+ШGJЪЬЮЬб*ШEJЪЬЮШJШЧЧЪаЩЩ`JЪЬЮЬЮЬЩ)JЪЬ$Щ$JЪЬЮЬЩ+ЧJЩfJЩ.ЧЪаЩЪ╨bn
ЬЮЬЮЬШ.JЪЬЮЬШJШJЪЬЮЬ#бШLJЪЬЮЬ	ШJШJШ ЧЪ
╧nЬЮЬЮЬЮЬЮЬШFЪЮЬЮЬШ JЪЬЮЬШ*JЪЬЮЬ"Ш7JШJШJЪЬЮЬ	Ш"JЪЮЬ	ЮЬЮЬЮЬШ2JШЧJШЧЧЪаЩЪг
ЬЮЬЮЬЮЬ!ШSЪЮЬЮЬШ JЪЬЮЬШ*JЪЬЮЬШ3JЪЬЮЬШJШJШJЪЮЬЮЬЮЬЮЬШ&JЪЬЮЬ(Ш3JШJШЪЮШЪЮЬЮЬЮЬЮШ&JШJШJЪЮЬШЧJШJЪ
ЮЬЮЬЮЬЮЬЮЬШ&JЪЮЬШЧJШЧJШJШ ЧЪг
ЬЮЬЮЬШJЪ	Ь6ЮЬЮЬЮЬЮЬШYJЪЬШЪЮЬЮЬШ JЪЬЮЬШ*JЪЮЬ	ЮЬЮЬЮЬШJШJЪЬЮЬШJШJЪЬЮЬЮЬШ-JЪЬЮЬЮЬШ:JЪЮЬЮЬ*Ш>JЪЮЬ	ЮЬЮЬЮЬШ2JШЧJШЧЧЪаЩЪвЬЮЬ%Ш?JЪЬЮЬЮЬШJЪЬЮЬШ*JШJЪЮЬбЬЮЬЮЬШ:JЪЬЮЬЩЪЮЬЮШЪЬ	Ш	JЪЬ!Ш!JШЪЮЬЮЬШJШ5JШJЪЮЬЮЬЮЬЮЬШDJШЧJШЧЪЬ	Ш	JЪЬ!Ш!JЪЬЮЬШJШЧЪЬШЪЮЬЮЬЮЬЮЬЮЬЮЬШSJЪЬШJЪЬЮЬШJШЧЪЮЬЮЬШJЪЬЮШJШAJЪЬШJШЧJЪЮЬ"Ш&JШЧJЪЮЬЮЬШЧJЪЬЮЬШ*JЪЮЬЮЬ/ШGJЪЬШJШ ЧЪг
ЬЮЬШ#JЪЬЮЬШЪЮЬЮШJЪЮЬ)Ш-ЪЮЬШJШ!JЪ
ЮЬЮЬЮЬЮЬЮЬШKJШJШЧЧШJШ ЧЧЪвЬЮЬЮЬЮЬШ6JШ6JШ(JЪЬЮЬШJЪЬЮЬШJЪЮЬШJШJШ ЧЪгЬЮЬ&Ш:JШ)ЪЮЬШ!JЪЮЬ:Ш>ЧJШJШJШJШJШ ЧЪгЬЮЬ-ЮЬШ`JЪЮЬШ&JЪЬЮЬЮЬ,Ш@JЪЬЮЬ$Ш-JЪ
ЮЬЮЬЮЬЮЬЮЬШLJШ!JШJШ ЧЪгЬЮЬШ%ЪгЬЮЬЮЬЮЬШ.ЪЮЬ!ЮЬЮЬЮШ6JЪЮЬЮЬЮЬЮЬШ!JЪЮЬШЧJЪЮЬЮЬШJШЧJШJШJШJШJЪЬЮЬ	ШJЪЮЬЮЬЮЬШ/JШJШJШJШJШJШJЪЮЬЮЬЮЬШ7JЪЮЬЮЬШ,JШJШ ЧЪгЬЮЬ#ЮЬШWJЪЬЮЬШJШ)JШJШЪЮЬЮЬЮЬЮШЪЮЬЮЬЮЬЮШ&JЪЬЮЬШJЪЬЮЬШJЪЬЮЬШЪЮЬ	ЮЬШJШJШJЪЬШЧJЪЮЬШЧJШJЪ
ЮЬЮЬЮЬЮЬЮЬШ&JЪЮЬШЧJШЧЧЪаЩЪ
гЬЮЬ!ЮЬЮЬЮЬШRJШHJШJШ ЧЪгЬЮЬШ0JЪЬЮЬШ%JЪЬЮЬШ*ЪгЬЮЬЩЪгЬЮЬЮЬЮЬЩ&JЪЬ'Щ'JЩ4JЪЬ'Щ'JЪЬ*Щ*JЩЧJЪЬЮЬЮЬЮЬЩJJЪЬЮЬЮЬЩCJЪЬЮЬЮЬЮЬЩ?JЪЬЩЧJЪгЬЮЬLШVЪвЬЮЬШJШ)JШJШJШJЩ	ЪЮШЪЮЬЮЬЮЬЮШ&JЪЬШJЪЮЬШЧJЪЮЬЮЬ.ШDJЪЮЬЮЬЮЬШJШJЪ
ЮЬЮЬЮЬЮЬЮЬШ&JЪЮЬШЧJШЧJЪЮЬ	ЮЬЮЬЮЬШЪЮЬЮШJЪЮЬ+ЮЬШ5JЪЮЬDШHЧJЪЬЮЬЩJШЧЧЪаЩЪ
гЬЮЬЮЬЮЬЮЬШFЪЮЬЮЬЮЬШ"JЪЬЮЬШ'JЪЮЬ	ЮЬЮЬЮЬШ2JШЧJШJШ ЧЪгЬЮЬЮЬЮЬШBЪЮЬЮЬЮШ"JЪЮЬЮШ
JЪЮЬЮЬ$Ш/ЧJШJШ ЧЪгЬЮЬЮЬЮЬШFЪЮЬЮШJЪЮЬЮЬШЪЮЬШJЪЬЮЬШ*JЪЬЮЬШJШJШJЪЮЬЮЬЮЬЮЬЮЬЮЬШPЪЮШJШ3JШJЪ
ЮЬЮЬЮЬЮЬЮЬШ&JЪЮЬШЧJЪЮЬШJШЧЧJШЧЧJШ JЪЮЬШJШШ ЪгЬЮЬЮЬ	ЮЬЩMЪЮЬЮЬЩ"JЪЮЬЩЪЮЬЩJЩJЩ3JЩ ЪЮЩJЪЮЬЮЬЮЬЩ)JЪЮЬЮЬЮЬЩJЩ#JЩJЪЮЬЩЧJЩЧЧJЩJЩ ЧЧJШ JШ Ч ЕЧ      0°  