DIRECTORY G2dBasic, G3dBasic, G3dNats, Real, Rope;

G3dNatsImpl: CEDAR MONITOR
IMPORTS G2dBasic, Real
EXPORTS G3dNats

~ BEGIN
ROPE:							TYPE ~ Rope.ROPE;
IntegerPairSequence:		TYPE ~ G2dBasic.IntegerPairSequence;
IntegerPairSequenceRep:	TYPE ~ G2dBasic.IntegerPairSequenceRep;
NatSequence:					TYPE ~ G2dBasic.NatSequence;
NatSequenceRep:				TYPE ~ G2dBasic.NatSequenceRep;
BoolSequence:				TYPE ~ G3dBasic.BoolSequence;
BoolSequenceRep:			TYPE ~ G3dBasic.BoolSequenceRep;
NatTable:						TYPE ~ G3dNats.NatTable;
NatTableRep:					TYPE ~ G3dNats.NatTableRep;

Error:						PUBLIC SIGNAL [reason: ROPE] = CODE;
NewNatSequence3: PUBLIC PROC [v0, v1, v2: INT] RETURNS [nats: NatSequence] ~ {
nats м NEW[NatSequenceRep[3]];
nats.length м 3;
nats[0] м v0;
nats[1] м v1;
nats[2] м v2;
};

EqualNatSequences: PUBLIC PROC [s1, s2: NatSequence] RETURNS [BOOL] ~ {
match: BoolSequence м NEW[BoolSequenceRep[s1.length]];
match.length м s1.length;
IF s1=NIL OR s2=NIL THEN RETURN [FALSE];
IF s1.length # s2.length THEN RETURN [FALSE];
FOR i: INT IN [0 .. s1.length) DO
match[i] м FALSE;  
FOR j: INT IN [0 .. s2.length) DO
IF s2[j] = s1[i] THEN { match[i] м TRUE; EXIT; };
ENDLOOP;
ENDLOOP;
FOR i: INT IN [0 .. match.length) DO
IF NOT match[i] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
};

GetCommonElementInNatSequences: PUBLIC PROC [n1, n2: NatSequence] RETURNS [INT м -1] ~ {
IF n1=NIL OR n2=NIL THEN RETURN;
FOR i: INT IN [0 .. n1.length) DO
FOR j: INT IN [0 .. n2.length) DO
IF n1[i] = n2[j] THEN RETURN [n1[i]];
ENDLOOP;
ENDLOOP;
};

GetNatSequenceIndex: PUBLIC PROC [nats: NatSequence, nat: NAT] RETURNS [INT м -1] ~ {
IF nats=NIL THEN RETURN;
FOR i: INT IN [0 .. nats.length) DO
IF nats[i] = nat THEN RETURN[i];
ENDLOOP;
};

ReplaceNatInSequence: PUBLIC PROC[n: NatSequence, old, new: NAT]RETURNS[r: NatSequence]~{
r м NIL;
IF n=NIL THEN RETURN;
FOR i: INT IN [0 .. n.length) DO
IF n[i] # old 
THEN r м G2dBasic.AddToNatSequence[r, n[i]]
ELSE r м G2dBasic.AddToNatSequence[r, new];
ENDLOOP;
};

RemoveNatInSequence: PUBLIC PROC[n: NatSequence, old: NAT] RETURNS [r: NatSequence м NIL ]~{
IF n=NIL THEN RETURN;
FOR i: INT IN [0 .. n.length) DO
IF n[i] # old THEN r м G2dBasic.AddToNatSequence[r, n[i]]
ENDLOOP;
};

GetUniqueElement: PUBLIC PROC [ns: NatSequence] RETURNS [unique: INT м -1] ~ {
IF ns=NIL THEN RETURN;
FOR i: INT IN [0 .. ns.length) DO
repeat: BOOL м FALSE;
FOR j: INT IN [0 .. ns.length) DO
IF (i#j) AND (ns[i]=ns[j]) THEN repeatмTRUE;
ENDLOOP;
IF NOT repeat THEN
IF unique < 0   
THEN unique м ns[i]
ELSE Error["no single unique element"]
ENDLOOP;
};

GetRepeatedElement: PUBLIC PROC [ns: NatSequence] RETURNS [INT м -1] ~ {
IF ns=NIL THEN RETURN;
FOR i: INT IN [0 .. ns.length) DO
FOR j: INT IN [0 .. ns.length) DO
IF (i#j) AND (ns[i]=ns[j]) THEN RETURN[ns[i]];
ENDLOOP;
ENDLOOP;
};

GetElementNotShared: PUBLIC PROC [v: NAT, ns: NatSequence] RETURNS [unique: INT м -1] ~ {
IF ns=NIL THEN RETURN;
FOR i: INT IN [0 .. ns.length) DO
IF ns[i] # v THEN 
IF unique < 0 THEN unique м ns[i]
ELSE Error["repeated unique vertex"];
ENDLOOP;
};

NatInSequence: PUBLIC PROC [nat: NAT, seq: NatSequence] RETURNS [BOOL] ~ {
IF seq=NIL THEN RETURN [FALSE];
FOR i: INT IN [0 .. seq.length) DO IF seq[i]=nat THEN RETURN [TRUE]; ENDLOOP;
RETURN[FALSE];
};

NatSequenceLength: PUBLIC PROC [seq: NatSequence] RETURNS [INT] ~ {
IF seq = NIL THEN RETURN[0] ELSE RETURN [seq.length];
};
CopyNatTable: PUBLIC PROC [nats: NatTable]
RETURNS [NatTable] ~ {
copy: NatTable м NIL;
IF nats # NIL THEN {
copy м NEW[NatTableRep[nats.length]];
copy.length м nats.length;
FOR n: NAT IN [0..nats.length) DO copy[n] м nats[n]; ENDLOOP;
};
RETURN[copy];
};

AddToNatTable: PUBLIC PROC [nats: NatTable, nat: NatSequence]
RETURNS [NatTable] ~ {
IF nats = NIL THEN nats м NEW[NatTableRep[1]];
IF nats.length = nats.maxLength THEN nats м LengthenNatTable[nats];
nats[nats.length] м nat;
nats.length м nats.length+1;
RETURN[nats];
};
LengthenNatTable: PUBLIC PROC [nats: NatTable, amount: REAL м 1.3] RETURNS [new: NatTable] ~ {
newLength: CARDINAL м Real.Ceiling[amount*nats.maxLength];
newLength м MAX[newLength, 3];
new м NEW[NatTableRep[newLength]];
FOR i: NAT IN [0..nats.length) DO new[i] м nats[i]; ENDLOOP;
new.length м nats.length;
};
scratchNats: ARRAY [0..10) OF NatSequence м ALL[NIL];
scratchIntegerPairs: ARRAY [0..10) OF IntegerPairSequence м ALL[NIL];

ObtainScratchNats: PUBLIC ENTRY PROC [length: INTEGER] RETURNS [NatSequence] ~ {
FOR i: NAT IN [0..10) DO
scratch: NatSequence м scratchNats[i];
IF scratch = NIL OR scratch.maxLength < CARDINAL[length] THEN LOOP;
scratchNats[i] м NIL;
RETURN[scratch];
ENDLOOP;
RETURN[NEW[NatSequenceRep[length]]];
};

ReleaseScratchNats: PUBLIC ENTRY PROC [scratch: NatSequence] ~ {
FOR i: INTEGER IN [0..10) DO
IF scratchNats[i] # NIL AND scratch.maxLength <= scratchNats[i].maxLength THEN LOOP;
scratchNats[i] м scratch;
RETURN;
ENDLOOP;
};

ObtainScratchIntegerPairs: PUBLIC ENTRY PROC [length: INTEGER]
RETURNS [IntegerPairSequence]
~ {
FOR i: NAT IN [0..10) DO
scratch: IntegerPairSequence м scratchIntegerPairs[i];
IF scratch = NIL OR scratch.maxLength < CARDINAL[length] THEN LOOP;
scratchIntegerPairs[i] м NIL;
RETURN[scratch];
ENDLOOP;
RETURN[NEW[IntegerPairSequenceRep[length]]];
};

ReleaseScratchIntegerPairs: PUBLIC ENTRY PROC [scratch: IntegerPairSequence] ~ {
FOR i: INTEGER IN [0..10) DO
IF scratchIntegerPairs[i] # NIL AND scratch.maxLength <= scratchIntegerPairs[i].maxLength
THEN LOOP;
scratchIntegerPairs[i] м scratch;
RETURN;
ENDLOOP;
};

END.


   6  
G3dNatsImpl.mesa
Copyright ╙ 1985, 1992 by Xerox Corporation.  All rights reserved.
Glassner, February 19, 1991 10:43 am PST
Jules Bloomenthal August 26, 1992 3:25 pm PDT

Imported Types
NatSequence Support
Return TRUE iff the two surfaces are the same
dumb n2 test, but I only expect these to be three long anyway.  Return -1 if none shared.
return index into sequence where nat appears, else -1
returns the single unrepeated element in ns
returns that single element in n1 that is not v
test if this nat is in this sequence
NatTable Sequences

Scratch Pool
Э╩	Ё  Ц"cedarcode" styleХNewlineDelimiter
Щ ЩJЪЬ	╧eЬ6ЩBJЩ(JЩ-JЩ JЪ╧k	Ь)Ш2JШ ЧЪ╤blnЬЮЬЮШJЪЮЬШJЪЮЬШJШ ЧJЪЬЮШheadЪ╧lЩJЪЮЬЮЬЮЬШJЪЬЮЬ Ш:JЪЬЮЬ#Ш?JЪЬЮЬШ-JЪЬЮЬШ2JЪЬЮЬШ.JЪЬЮЬШ3JЪЬЮЬШ'JЪЬЮЬШ,JШ JЪ╧nЬЮЮЬЮЬ
ЮЬЮЬШ0ЧЪаЩЪ
бЬЮЬЮЬЮЬЮЬШNJЪЬЮЬШJШJШJШJШJШJШ ЧЪ
бЬЮЬЮЬЮЬЮЬШGJЩ-JЪЬЮЬШ6JШJЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ(JЪЮЬЮЬЮЬЮЬШ-ЪЮЬЮЬЮЬЮШ!JЪЬЮЬШЪЮЬЮЬЮЬЮШ!JЪЮЬЮЬЮЬЮЬШ1JЪЮЬШЧJЪЮЬШЧЪЮЬЮЬЮЬЮШ$JЪ
ЮЬЮЬ
ЮЬЮЬЮЬШ#JЪЮЬШЧJЪЮЬЮЬШJШJШ ЧЪ
бЬЮЬЮЬЮЬЮЬ
ШXJЪЬ╧uЬRЩYJЪЮЬЮЬЮЬЮЬЮЬЮЬШ ЪЮЬЮЬЮЬЮШ!ЪЮЬЮЬЮЬЮШ!JЪЮЬЮЬЮЬ	Ш%JЪЮЬШЧJЪЮЬШЧJШJШ ЧЪбЬЮЬЮЬЮЬЮЬЮЬ
ШUJЩ5JЪЮЬЮЬЮЬЮЬШЪЮЬЮЬЮЬЮШ#JЪЮЬЮЬЮЬШ JЪЮЬШЧJШJШ ЧЪ
бЬЮЬЮЬЮЬЮЬШYJЪЬЮЬШJЪЮЬЮЬЮЬЮЬШЪЮЬЮЬЮЬЮШ ЪЮЬШJЪЮЬ'Ш+JЪЮЬ'Ш+ЧJЪЮЬШЧJШJШ ЧЪбЬЮЬЮЬЮЬЮЬЮЬШ\JЪЮЬЮЬЮЬЮЬШЪЮЬЮЬЮЬЮШ JЪЮЬЮЬ'Ш9JЪЮЬШЧJШJШ ЧЪ
бЬЮЬЮЬЮЬ
ЮЬ
ШNJЪЬ+Щ+JЪЮЬЮЬЮЬЮЬШЪЮЬЮЬЮЬЮШ!JЪЬЮЬЮЬШЪЮЬЮЬЮЬЮШ!JЪЮЬЮЬЮЬЮЬШ,JЪЮЬШЧЪЮЬЮЬЮШЪЮЬШJЪЮЬШJЪЮЬ"Ш&ЧЧJЪЮЬШЧJШJШ ЧЪ
бЬЮЬЮЬЮЬЮЬ
ШHJЪЮЬЮЬЮЬЮЬШЪЮЬЮЬЮЬЮШ!ЪЮЬЮЬЮЬЮШ!JЪЮЬЮЬЮЬЮЬШ.JЪЮЬШЧJЪЮЬШЧJШJШ ЧЪбЬЮЬЮЬЮЬЮЬ
ЮЬ
ШYJЪЬ/Щ/JЪЮЬЮЬЮЬЮЬШЪЮЬЮЬЮЬЮШ!ЪЮЬЮЬШJЪЮЬЮЬШ!JЪЮЬ!Ш%ЧJЪЮЬШЧJШJШ ЧЪбЬЮЬЮЬЮЬЮЬЮЬШJJЪЬ$Щ$JЪ
ЮЬЮЬЮЬЮЬЮЬШJЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШMJЪЮЬЮЬШJШЧJШ Ъ
бЬЮЬЮЬЮЬЮЬШCJЪЮЬЮЬЮЬЮЬЮЬЮЬШ5JЪЬШЧЧЪаЩЪбЬЮЬЮЬЮЬШAJЪЬЮЬШЪЮЬЮЬЮЬШJЪЬЮЬШ%JШJЪ
ЮЬЮЬЮЬЮЬЮЬШ=JШЧJЪЮЬШJШJШ ЧЪбЬЮЬЮЬ$ЮЬШTJЪЮЬЮЬЮЬЮЬШ.JЪЮЬЮЬШCJШJШJЪЮЬШJШJЩ ЧЪ
бЬЮЬЮЬЮЬЮЬШ^JЪЬЮЬ'Ш:JЪЬЮЬШJЪЬЮЬШ"JЪ
ЮЬЮЬЮЬЮЬЮЬШ<JШJШЧЧЪаЩJЪ	ЬЮЬ	ЮЬЮЬЮЬШ5Ъ	ЬЮЬ	ЮЬЮЬЮЬШEJШ ЧЪ
бЬЮЬЮЬ
ЮЬЮЬШPЪЮЬЮЬЮЬ	ЮШJШ&JЪЮЬЮЬЮЬЮЬ	ЮЬЮЬШCJЪЬЮЬШJЪЮЬ
ШJЪЮЬШЧJЪЮЬЮЬШ$JШJШ ЧЪбЬЮЬЮЬШ@ЪЮЬЮЬЮЬ	ЮШJЪ
ЮЬЮЬЮЬ/ЮЬЮЬШTJШJЪЮЬШJЪЮЬШЧJШJШ ЧЪбЬЮЬЮЬ
ЮЬШ>JЪЮЬШJШЪЮЬЮЬЮЬ	ЮШJШ6JЪЮЬЮЬЮЬЮЬ	ЮЬЮЬШCJЪЬЮЬШJЪЮЬ
ШJЪЮЬШЧJЪЮЬЮЬ"Ш,JШJШ ЧЪбЬЮЬЮЬ#ШPЪЮЬЮЬЮЬ	ЮШЪЮЬЮЬЮЬ6ШYJЪЮЬЮЬШ
ЧJШ!JЪЮЬШJЪЮЬШЧJШЧJШ ЧJЪЮЬШJШ JШ Ч ЕЧ    v  !Ь  