
<<IPConvertImpl.mesa>>
<<>>
<<Last edited by:>>
<<Doug Wyatt, March 3, 1984 2:39:53 pm PST>>

DIRECTORY
Atom USING [GetPName, MakeAtomFromRefText],
IO USING [PutFR, int, real, rope, STREAM],
IP USING [Any, CheckInteger, Color, Get, Identifier, Integer, MasterError, MasterWarning, maxInteger, Number, NumberRep, Operator, 
Outline, PixelArray, RealFromInt, RealFromInteger, Shape, Trajectory, Transformation, TypeCode, Vector, VectorShape],
Real USING [Fix, RealException],
RefText USING [AppendChar, ObtainScratch, ReleaseScratch],
Rope USING [Concat, Fetch, ROPE, Size, Substr];

IPConvertImpl: CEDAR PROGRAM
IMPORTS Atom, IO, IP, Real, RefText, Rope
EXPORTS IP
= BEGIN OPEN IP;

ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;

WrongType: PROC[expectedType: TypeCode] ~ {
rope: ROPE ~ RopeFromType[expectedType];
MasterError[$wrongType, IO.PutFR["Value has wrong type (%g expected).", IO.rope[rope]]];
};

IntegerFromInt: PUBLIC PROC[x: INT] RETURNS[Integer] ~ {
IF x IN[0..maxInteger] THEN RETURN[x];
MasterError[$notInteger, IO.PutFR["%g is not an Integer.", IO.int[x]]];
RETURN[0]; -- never actually returns
};

IntegerFromReal: PUBLIC PROC[x: REAL] RETURNS[Integer] ~ {
Fix: PROC[r: REAL] RETURNS[INT] ~ { RETURN[Real.Fix[r]] };
<<Wrap a procedure call around Real.Fix so we can catch RealException>>
i: INT _ 0; ok: BOOL _ TRUE;
i _ Fix[x ! Real.RealException => { ok _ FALSE; CONTINUE }];
IF ok AND i=x AND i IN[0..maxInteger] THEN RETURN[i];
MasterError[$notInteger, IO.PutFR["%g is not an Integer.", IO.real[x]]];
RETURN[0]; -- never actually returns
};

NullWarning: PROC ~ {
MasterWarning[$nullValue, "Used initial zero value."];
};

IntegerFromAny: PUBLIC PROC[x: Any] RETURNS[Integer] ~ {
WITH x SELECT FROM x: Number => RETURN[IntegerFromReal[x.value]]; ENDCASE;
IF x=NIL THEN NullWarning[] ELSE WrongType[$Number]; RETURN[0];
};

RealFromAny: PUBLIC PROC[x: Any] RETURNS[REAL] ~ {
WITH x SELECT FROM x: Number => RETURN[x.value]; ENDCASE;
IF x=NIL THEN NullWarning[] ELSE WrongType[$Number]; RETURN[0];
};

AnyFromInteger: PUBLIC PROC[i: Integer] RETURNS[Any] ~ {
RETURN[NEW[NumberRep _ [value: RealFromInteger[CheckInteger[i]]]]];
};

AnyFromInt: PUBLIC PROC[i: INT] RETURNS[Any] ~ {
RETURN[NEW[NumberRep _ [value: RealFromInt[i]]]];
};

AnyFromReal: PUBLIC PROC[r: REAL] RETURNS[Any] ~ {
RETURN[NEW[NumberRep _ [value: r]]];
};

PrivateCheckInteger: PUBLIC PROC[x: Integer] RETURNS[Integer] ~ {
IF x IN[0..maxInteger] THEN RETURN[x];
MasterError[$bug, IO.PutFR["%g is not a valid Integer.", IO.int[x]]];
RETURN[0]; -- never actually returns
};

zero: Any ~ AnyFromInteger[0];

PrivateCheckAny: PUBLIC PROC[x: Any] RETURNS[Any] ~ {
IF x#NIL THEN RETURN[x];
NullWarning[]; RETURN[zero];
};


IdentifierFromAny: PUBLIC PROC[x: Any] RETURNS[Identifier] ~ {
WITH x SELECT FROM x: Identifier => RETURN[x]; ENDCASE;
WrongType[$Identifier]; RETURN[NIL];
};

VectorFromAny: PUBLIC PROC[x: Any] RETURNS[Vector] ~ {
WITH x SELECT FROM x: Vector => RETURN[x]; ENDCASE;
WrongType[$Vector]; RETURN[NIL];
};

OperatorFromAny: PUBLIC PROC[x: Any] RETURNS[Operator] ~ {
WITH x SELECT FROM x: Operator => RETURN[x]; ENDCASE;
WrongType[$Operator]; RETURN[NIL];
};

TransformationFromAny: PUBLIC PROC[x: Any] RETURNS[Transformation] ~ {
WITH x SELECT FROM x: Transformation => RETURN[x]; ENDCASE;
WrongType[$Transformation]; RETURN[NIL];
};

PixelArrayFromAny: PUBLIC PROC[x: Any] RETURNS[PixelArray] ~ {
WITH x SELECT FROM x: PixelArray => RETURN[x]; ENDCASE;
WrongType[$PixelArray]; RETURN[NIL];
};

ColorFromAny: PUBLIC PROC[x: Any] RETURNS[Color] ~ {
WITH x SELECT FROM x: Color => RETURN[x]; ENDCASE;
WrongType[$Color]; RETURN[NIL];
};

TrajectoryFromAny: PUBLIC PROC[x: Any] RETURNS[Trajectory] ~ {
WITH x SELECT FROM x: Trajectory => RETURN[x]; ENDCASE;
WrongType[$Trajectory]; RETURN[NIL];
};

OutlineFromAny: PUBLIC PROC[x: Any] RETURNS[Outline] ~ {
WITH x SELECT FROM x: Outline => RETURN[x]; ENDCASE;
WrongType[$Outline]; RETURN[NIL];
};


NonDefaultingROPE: TYPE ~ ROPE _;
RopeFromTypeTable: TYPE ~ ARRAY TypeCode OF NonDefaultingROPE;
ropeFromType: REF RopeFromTypeTable ~ NEW[RopeFromTypeTable _ [Null: "Null", Number: "Number", Identifier: "Identifier", Vector: 
"Vector", Operator: "Operator", Transformation: "Transformation", PixelArray: "PixelArray", Color: "Color", Trajectory: 
"Trajectory", Outline: "Outline", Other: "Other"]];

RopeFromType: PUBLIC PROC[type: TypeCode] RETURNS[rope: ROPE] ~ {
RETURN[ropeFromType[type]];
};

IllegalIdentifier: PROC[id: ROPE] ~ {
MasterWarning[$illegalIdentifier,
IO.PutFR["\"%g\" is an illegal Identifier.", IO.rope[id]]];
};

IdentifierTooLong: PROC[id: ROPE] ~ {
MasterError[$limitExceeded,
IO.PutFR["\"%g...\" is too long for an Identifier.", IO.rope[id.Substr[len: 20]]]];
};

IdentifierFromRope: PUBLIC PROC[rope: ROPE] RETURNS[id: Identifier] ~ {
size: INT ~ rope.Size[];
IF size<=NAT.LAST THEN {
len: NAT ~ size;
scratch: REF TEXT ~ RefText.ObtainScratch[len];
{ ENABLE UNWIND => RefText.ReleaseScratch[scratch];
text: REF TEXT _ scratch;
FOR i: NAT IN[0..len) DO
char: CHAR _ rope.Fetch[i];
SELECT char FROM
IN['a..'z] => NULL;
IN['A..'Z] => char _ char+('a-'A); -- map upper case to lower case
IN['0..'9], '- => IF i=0 THEN IllegalIdentifier[rope];
ENDCASE => IllegalIdentifier[rope];
text _ RefText.AppendChar[text, char];
ENDLOOP;
id _ Atom.MakeAtomFromRefText[text];
};
RefText.ReleaseScratch[scratch];
}
ELSE IdentifierTooLong[rope];
};

RopeFromIdentifier: PUBLIC PROC[id: Identifier] RETURNS[rope: ROPE] ~ {
RETURN[Atom.GetPName[id]];
};

NameFromVector: PUBLIC PROC[v: Vector] RETURNS[rope: ROPE _ NIL] ~ {
shape: VectorShape ~ Shape[v];
FOR i: Integer IN[shape.l .. shape.l+shape.n) DO
IF rope#NIL THEN rope _ rope.Concat["/"];
rope _ rope.Concat[RopeFromIdentifier[IdentifierFromAny[Get[v, i]]]];
ENDLOOP;
};

END.