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]] }; 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. ˜IPConvertImpl.mesa Last edited by: Doug Wyatt, March 3, 1984 2:39:53 pm PST Wrap a procedure call around Real.Fix so we can catch RealException ÊR˜Jšœ™J™šœ™Jšœ(™(—J˜šÏk ˜ Jšœœ!˜+Jšœœœ˜*Jšœœð˜øJšœœ˜ Jšœœ-˜:Jšœœœ˜/J˜—Jšœœ˜Jšœœœ˜)Jšœ˜ Jšœœœœ˜J˜Jšœœœ˜Jšœœœœ˜J˜šÏn œœ˜+Jšœœ˜(Jšœœ.œ˜XJ˜J˜—š žœœœœœ ˜8Jšœœœœ˜&Jšœœ œ ˜GJšœÏc˜$J˜J˜—š žœœœœœ ˜:š žœœœœœœ˜:JšœC™C—Jšœœ œœ˜Jšœ)œœ˜Jš œœœœœ˜7Jšœœœ˜$J˜J˜—šž œœœ œ ˜6Jš œœœœœ˜3Jšœœœ˜ J˜J˜—šžœœœ œ˜:Jš œœœœœ˜5Jšœœœ˜"J˜J˜—šžœœœ œ˜FJš œœœœœ˜;Jšœœœ˜(J˜J˜—šžœœœ œ˜>Jš œœœœœ˜7Jšœœœ˜$J˜J˜—šž œœœ œ ˜4Jš œœœ œœ˜2Jšœœœ˜J˜J˜—šžœœœ œ˜>Jš œœœœœ˜7Jšœœœ˜$J˜J˜—šžœœœ œ ˜8Jš œœœœœ˜4Jšœœœ˜!J˜J˜—J˜Jšœœœ˜!Jšœœœ œ˜>Jšœœœƒ˜¬J˜š ž œœœœœ˜AJšœ˜Jšœ˜J˜—šžœœœ˜%šœ!˜!Jšœ+œ ˜;—J˜J˜—šžœœœ˜%šœ˜Jšœ3œ˜S—J˜J˜—š žœœœœœ˜GJšœœ˜šœœœœ˜Jšœœ˜Jšœ œœ˜/šœœœ$˜3Jšœœœ ˜šœœœ ˜Jšœœ˜šœ˜Jšœ œ˜Jšœ!Ÿ˜BJšœœœ˜6Jšœ˜#—J˜&Jšœ˜—J˜$J˜—Jšœ ˜ J˜—Jšœ˜Jšœ˜J˜—š žœœœœœ˜GJšœ˜Jšœ˜J˜—š žœœœ œœœ˜DJ˜šœ œ˜0Jšœœœ˜)J˜EJšœ˜—Jšœ˜J˜—Jšœ˜—…—úä