DIRECTORY
PS,
Convert,
Real,
RefText,
Rope;

PSTypeImpl: CEDAR PROGRAM
IMPORTS PS, Convert, Real, RefText, Rope
EXPORTS PS
~ BEGIN OPEN PS;
NameFromTypeArray: TYPE ~ ARRAY TypeCode OF Name;
nameFromType: REF NameFromTypeArray ~ NEW [NameFromTypeArray _ [
null: NameFromRope["nulltype"],
integer: NameFromRope["integertype"],
real: NameFromRope["realtype"],
boolean: NameFromRope["booleantype"],
array: NameFromRope["arraytype"],
string: NameFromRope["stringtype"],
name: NameFromRope["nametype"],
dict: NameFromRope["dicttype"],
operator: NameFromRope["operatortype"],
file: NameFromRope["filetype"],
mark: NameFromRope["marktype"],
save: NameFromRope["savetype"],
font: NameFromRope["fonttype"]
]];

NameFromType: PUBLIC PROC [type: TypeCode] RETURNS [Name] ~ {
RETURN [nameFromType[type]];
};


CvLit: PUBLIC PROC [x: Any] RETURNS [Any] ~ {
x.val.executable _ FALSE;
RETURN [x];
};

CvX: PUBLIC PROC [x: Any] RETURNS [Any] ~ {
x.val.executable _ TRUE;
RETURN [x];
};

ArraySetAccess: PROC [array: Array, access: Access] RETURNS [Array] ~ {
IF array.val.access<access THEN ERROR Error[invalidaccess];
array.val.access _ access;
RETURN [array];
};

StringSetAccess: PROC [string: String, access: Access] RETURNS [String] ~ {
IF string.val.access<access THEN ERROR Error[invalidaccess];
string.val.access _ access;
RETURN [string];
};

DictSetAccess: PROC [dict: Dict, access: Access] RETURNS [Dict] ~ {
IF access=executeOnly THEN ERROR Error[typecheck];
IF dict.ref.access<access THEN ERROR Error[invalidaccess];
dict.ref.access _ access;
RETURN [dict];
};

FileSetAccess: PROC [file: File, access: Access] RETURNS [File] ~ {
IF file.val.access<access THEN ERROR Error[invalidaccess];
file.val.access _ access;
RETURN [file];
};

GetAccess: PUBLIC PROC [x: Any] RETURNS [Access] ~ {
SELECT Type[x] FROM
array => RETURN [ArrayAccess[ArrayFromAny[x]]];
dict => RETURN [DictAccess[DictFromAny[x]]];
file => RETURN [FileAccess[FileFromAny[x]]];
string => RETURN [StringAccess[StringFromAny[x]]];
ENDCASE => ERROR Error[typecheck];
};

SetAccess: PUBLIC PROC [x: Any, access: Access] RETURNS [Any] ~ {
SELECT Type[x] FROM
array => RETURN [AnyFromArray[ArraySetAccess[ArrayFromAny[x], access]]];
dict => RETURN [AnyFromDict[DictSetAccess[DictFromAny[x], access]]];
file => RETURN [AnyFromFile[FileSetAccess[FileFromAny[x], access]]];
string => RETURN [AnyFromString[StringSetAccess[StringFromAny[x], access]]];
ENDCASE => ERROR Error[typecheck];
};


IntFromAny: PUBLIC PROC [x: Any] RETURNS [INT] ~ {
WITH val: x.val SELECT FROM
integer => RETURN [val.int];
ENDCASE => ERROR Error[typecheck];
};

RealFromAny: PUBLIC PROC [x: Any] RETURNS [REAL] ~ {
WITH val: x.val SELECT FROM
integer => RETURN [REAL[val.int]];
real => RETURN [val.real];
ENDCASE => ERROR Error[typecheck];
};

NumFromAny: PUBLIC PROC [x: Any] RETURNS [Num] ~ {
WITH val: x.val SELECT FROM
integer => RETURN [[int[val.int]]];
real => RETURN [[real[val.real]]];
ENDCASE => ERROR Error[typecheck];
};

BoolFromAny: PUBLIC PROC [x: Any] RETURNS [BOOL] ~ {
WITH val: x.val SELECT FROM
boolean => RETURN [val.bool];
ENDCASE => ERROR Error[typecheck];
};

ArrayFromAny: PUBLIC PROC [x: Any] RETURNS [Array] ~ {
WITH val: x.val SELECT FROM
array => WITH x.ref SELECT FROM
ref: ArrayRef => RETURN [[val: val, ref: ref]];
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};

StringFromAny: PUBLIC PROC [x: Any] RETURNS [String] ~ {
WITH val: x.val SELECT FROM
string => WITH x.ref SELECT FROM
ref: StringRef => RETURN [[val: val, ref: ref]];
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};

FileFromAny: PUBLIC PROC [x: Any] RETURNS [File] ~ {
WITH val: x.val SELECT FROM
file => WITH x.ref SELECT FROM
ref: FileRef => RETURN [[val: val, ref: ref]];
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};

NameFromAny: PUBLIC PROC [x: Any] RETURNS [Name] ~ {
WITH val: x.val SELECT FROM
name => WITH x.ref SELECT FROM
ref: NameRef => RETURN [[val: val, ref: ref]];
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};

DictFromAny: PUBLIC PROC [x: Any] RETURNS [Dict] ~ {
WITH val: x.val SELECT FROM
dict => WITH x.ref SELECT FROM
ref: DictRef => RETURN [[val: val, ref: ref]];
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};

OperatorFromAny: PUBLIC PROC [x: Any] RETURNS [Operator] ~ {
WITH val: x.val SELECT FROM
operator => WITH x.ref SELECT FROM
ref: OperatorRef => RETURN [[val: val, ref: ref]];
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};


AnyFromInt: PUBLIC PROC [int: INT] RETURNS [Any] ~ {
RETURN [[
val: [executable: FALSE, variant: integer[int: int]],
ref: NIL
]];
};

AnyFromReal: PUBLIC PROC [real: REAL] RETURNS [Any] ~ {
RETURN [[
val: [executable: FALSE, variant: real[real: real]],
ref: NIL
]];
};

AnyFromBool: PUBLIC PROC [bool: BOOL] RETURNS [Any] ~ {
RETURN [[
val: [executable: FALSE, variant: boolean[bool: bool]],
ref: NIL
]];
};

AnyFromArray: PUBLIC PROC [array: Array] RETURNS [Any] ~ {
RETURN [[val: array.val, ref: array.ref]];
};

AnyFromString: PUBLIC PROC [string: String] RETURNS [Any] ~ {
RETURN [[val: string.val, ref: string.ref]];
};

AnyFromName: PUBLIC PROC [name: Name] RETURNS [Any] ~ {
RETURN [[val: name.val, ref: name.ref]];
};

AnyFromDict: PUBLIC PROC [dict: Dict] RETURNS [Any] ~ {
RETURN [[val: dict.val, ref: dict.ref]];
};

AnyFromFile: PUBLIC PROC [file: File] RETURNS [Any] ~ {
RETURN [[val: file.val, ref: file.ref]];
};


Eq: PUBLIC PROC [x1, x2: Any] RETURNS [BOOL] ~ {
WITH v1: x1.val SELECT FROM
null => WITH v2: x2.val SELECT FROM
null => RETURN [TRUE];
ENDCASE;
integer => WITH v2: x2.val SELECT FROM
integer => RETURN [v1.int=v2.int];
real => RETURN [v1.int=v2.real];
ENDCASE;
real => WITH v2: x2.val SELECT FROM
integer => RETURN [v1.real=v2.int];
real => RETURN [v1.real=v2.real];
ENDCASE;
boolean => WITH v2: x2.val SELECT FROM
boolean => RETURN [v1.bool=v2.bool];
ENDCASE;
operator => WITH v2: x2.val SELECT FROM
operator => RETURN [x1.ref=x2.ref];
ENDCASE;
array => WITH v2: x2.val SELECT FROM
array => RETURN [x1.ref=x2.ref AND v1.start=v2.start AND v1.length=v2.length];
ENDCASE;
string => WITH v2: x2.val SELECT FROM
string => RETURN [StringEq[StringFromAny[x1], StringFromAny[x2]]];
name => RETURN [StringEq[StringFromAny[x1], NameFromAny[x2].ref^]];
ENDCASE;
file => WITH v2: x2.val SELECT FROM
file => RETURN [x1.ref=x2.ref];
ENDCASE;
name => WITH v2: x2.val SELECT FROM
name => RETURN [x1.ref=x2.ref];
string => RETURN [StringEq[NameFromAny[x1].ref^, StringFromAny[x2]]];
ENDCASE;
dict => WITH v2: x2.val SELECT FROM
dict => RETURN [x1.ref=x2.ref];
ENDCASE;
mark => WITH v2: x2.val SELECT FROM
mark => RETURN [TRUE];
ENDCASE;
font => WITH v2: x2.val SELECT FROM
font => RETURN [x1.ref=x2.ref];
ENDCASE;
ENDCASE;
RETURN [FALSE];
};

CharFromInt: PUBLIC PROC [int: INT] RETURNS [CHAR] ~ {
CharRange: TYPE ~ CARDINAL[0..CHAR.LAST.ORD];
IF int IN CharRange THEN RETURN [VAL[CharRange[int]]];
ERROR Error[rangecheck];
};

IntFromReal: PUBLIC PROC [real: REAL] RETURNS [INT] ~ {
RETURN [Real.Fix[real ! Real.RealException => CONTINUE]];
ERROR Error[rangecheck];
};

IntFromString: PUBLIC PROC [string: String] RETURNS [INT] ~ {
found: BOOL; token: Any; post: String;
[found, token, post] _ StringToken[string];
SELECT Type[token] FROM
integer => RETURN [IntFromAny[token]];
real => RETURN [IntFromReal[RealFromAny[token]]];
ENDCASE => ERROR Error[typecheck];
};

RealFromString: PUBLIC PROC [string: String] RETURNS [REAL] ~ {
found: BOOL; token: Any; post: String;
[found, token, post] _ StringToken[string];
SELECT Type[token] FROM
integer => RETURN [RealFromInt[IntFromAny[token]]];
real => RETURN [RealFromAny[token]];
ENDCASE => ERROR Error[typecheck];
};

StringFromInt: PUBLIC PROC [int, radix: INT, string: String] RETURNS [substring: String] ~ {
negative: BOOL ~ (int<0);
val: CARD _ ABS[int];
stack: ARRAY [0..32] OF CHAR;
length: NAT _ 0;
base: NAT _ 0;
IF radix IN [2..36] THEN base _ radix ELSE ERROR Error[rangecheck];
DO
digit: NAT ~ val MOD base;
stack[length] _ IF digit<10 THEN '0+digit ELSE 'A+(digit-10);
length _ length + 1;
IF val<base THEN EXIT ELSE val _ val/base;
ENDLOOP;
IF negative THEN { stack[length] _ '-; length _ length + 1 };
substring _ StringGetInterval[string, 0, length];
FOR index: INT IN[0..StringLength[substring]) DO
StringPut[substring, index, stack[length _ length-1]];
ENDLOOP;
IF length#0 THEN ERROR Bug;
};

StringFromReal: PUBLIC PROC [real: REAL, string: String] RETURNS [substring: String] ~ {
scratch: REF TEXT ~ RefText.ObtainScratch[100];
text: REF TEXT ~ Convert.AppendReal[to: scratch, from: real];
substring _ StringFromRefText[text, string];
RefText.ReleaseScratch[scratch];
};

StringFromRope: PUBLIC PROC [rope: ROPE, string: String] RETURNS [substring: String] ~ {
length: INT ~ Rope.Size[rope];
substring _ StringGetInterval[string, 0, length];
FOR index: INT IN [0..length) DO
StringPut[substring, index, Rope.Fetch[rope, index]];
ENDLOOP;
};

StringFromRefText: PUBLIC PROC [text: REF READONLY TEXT, string: String] RETURNS [substring: String] ~ {
length: NAT ~ text.length;
substring _ StringGetInterval[string, 0, length];
FOR index: NAT IN [0..length) DO
StringPut[substring, index, text[index]];
ENDLOOP;
};


END.

ΖPSTypeImpl.mesa
Copyright Σ 1986, 1987 by Xerox Corporation.  All rights reserved.
Doug Wyatt, May 15, 1987 5:47:54 pm PDT
PostScript implementation: type and attribute operations.

Type and Attribute operations
Comparison operators
Conversion
IF NOT found THEN ERROR Error[syntaxerror];
IF StringToken[post].found THEN ERROR Error[syntaxerror];
IF NOT found THEN ERROR Error[syntaxerror];
IF StringToken[post].found THEN ERROR Error[syntaxerror];
Κ₯˜
codeš
œ™Kš
œB™BK™'—K˜K™9K™š
Οk	˜	Kšœ
˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—K˜KšΟn
œœ
˜Kšœ
œ˜(Kšœ
˜
Kšœœ
œ
œ
˜
head™Kšœœœ
œ˜1šœœœ˜@Kš
œ˜Kš
œ%˜%Kš
œ˜Kš
œ%˜%Kš
œ!˜!Kš
œ#˜#Kš
œ˜Kš
œ˜Kš
œ'˜'Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—šžœœ
œœ˜=Kšœ˜K˜K˜—K˜šžœœ
œ
œ
˜-Kšœœ
˜Kšœ˜Kš
œ˜K˜—šžœœ
œ
œ
˜+Kšœœ
˜Kšœ˜Kš
œ˜K˜—šžœœ œ˜GKšœœ
œ˜;Kš
œ˜Kšœ	˜K˜K˜—šžœœ"œ
˜KKšœœ
œ˜<Kš
œ˜Kšœ
˜K˜K˜—šž
œœœ˜CKšœœ
œ˜2Kšœœ
œ˜:Kš
œ˜Kšœ˜K˜K˜—šž
œœœ˜CKšœœ
œ˜:Kš
œ˜Kšœ˜K˜K˜—šž	œœ
œ
œ
˜4šœ	˜Kšœ	œ ˜/Kšœœ˜,Kšœœ˜,Kšœ
œ"˜2Kšœœ˜"—K˜K˜—šž	œœ
œœ
˜Ašœ	˜Kšœ	œ9˜HKšœœ6˜DKšœœ6˜DKšœ
œ<˜LKšœœ˜"—K˜K˜—K˜š
ž
œœ
œ
œœ˜2šœœ
˜Kšœœ˜Kšœœ˜"—K˜K˜—š
žœœ
œ
œœ˜4šœœ
˜Kšœœœ˜"Kšœœ˜Kšœœ˜"—K˜K˜—šž
œœ
œ
œ
˜2šœœ
˜Kšœœ˜#Kšœœ˜"Kšœœ˜"—K˜K˜—š
žœœ
œ
œœ˜4šœœ
˜Kšœœ˜Kšœœ˜"—K˜K˜—šžœœ
œ
œ˜6šœœ
˜šœ	œœ
˜Kšœœ˜/Kšœœ˜—Kšœœ˜"—K˜K˜—šž
œœ
œ
œ
˜8šœœ
˜šœ
œœ
˜ Kšœœ˜0Kšœœ˜—Kšœœ˜"—K˜K˜—šžœœ
œ
œ˜4šœœ
˜šœœœ
˜Kšœœ˜.Kšœœ˜—Kšœœ˜"—K˜K˜—šžœœ
œ
œ˜4šœœ
˜šœœœ
˜Kšœœ˜.Kšœœ˜—Kšœœ˜"—K˜K˜—šžœœ
œ
œ˜4šœœ
˜šœœœ
˜Kšœœ˜.Kšœœ˜—Kšœœ˜"—K˜K˜—šžœœ
œ
œ˜<šœœ
˜šœœœ
˜"Kšœœ˜2Kšœœ˜—Kšœœ˜"—K˜K˜—K˜š
ž
œœ
œœœ
˜4šœ˜	Kšœœ˜5Kšœ˜Kš
œ˜—K˜K˜—š
žœœ
œœœ
˜7šœ˜	Kšœœ˜4Kšœ˜Kš
œ˜—K˜K˜—š
žœœ
œœœ
˜7šœ˜	Kšœœ ˜7Kšœ˜Kš
œ˜—K˜K˜—šžœœ
œœ
˜:Kšœ$˜*K˜K˜—šž
œœ
œœ
˜=Kšœ&˜,K˜K˜—šžœœ
œœ
˜7Kšœ"˜(K˜K˜—šžœœ
œœ
˜7Kšœ"˜(K˜K˜—šžœœ
œœ
˜7Kšœ"˜(K˜K˜—K˜—™š
žœœ
œœœ˜0šœœ
˜šœœœ
˜#Kšœœœ˜Kšœ
˜—šœœœ
˜&Kšœœ˜"Kšœœ˜ Kšœ
˜—šœœœ
˜#Kšœœ˜#Kšœœ˜!Kšœ
˜—šœœœ
˜&Kšœœ˜$Kšœ
˜—šœœœ
˜'Kšœœ˜#Kšœ
˜—šœ	œœ
˜$Kšœ	œœœ˜NKšœ
˜—šœ
œœ
˜%Kšœ
œ2˜BKšœœ5˜CKšœ
˜—šœœœ
˜#Kšœœ˜Kšœ
˜—šœœœ
˜#Kšœœ˜Kšœ
œ5˜EKšœ
˜—šœœœ
˜#Kšœœ˜Kšœ
˜—šœœœ
˜#Kšœœœ˜Kšœ
˜—šœœœ
˜#Kšœœ˜Kšœ
˜—Kšœ
˜—Kšœœ˜K˜K˜——™
šžœœ
œœœœ˜6Kšœœœœ
œ
œ˜-Kš
œœœ
œœ˜6Kšœ˜K˜K˜—šžœœ
œœœœ˜7Kšœ(œ˜9Kšœ˜K˜K˜—š
ž
œœ
œœœ˜=Kšœœ˜&K˜+Kšœ
œœ
œ™+Kšœœ
œ™9šœ
˜Kšœœ˜&Kšœœ#˜1Kšœœ˜"—K˜K˜—š
žœœ
œœœ˜?Kšœœ˜&K˜+Kšœ
œœ
œ™+Kšœœ
œ™9šœ
˜Kšœœ"˜3Kšœœ˜$Kšœœ˜"—K˜K˜—š
ž
œœ
œœœ˜\Jšœ
œ˜Jšœœœ˜Jšœœ	œ
œ
˜Jšœœ˜Jšœœ˜Jš
œœ	œœ
œ˜Cš
˜Jšœœœ˜Jšœœ
œ
œ˜=Jš
œ˜Jšœ
œ
œ
œ˜*Jšœ
˜—Jšœ
œ-˜=J˜1šœœ
œ˜0Jš
œ6˜6Jšœ
˜—Kšœ
œ
œ˜K˜K˜—š
žœœ
œœœ˜XKšœ	œ
œ˜/Kšœœ
œ/˜=Kš
œ,˜,Kš
œ ˜ K˜K˜—š
žœœ
œœœ˜XKšœœ˜Kš
œ1˜1šœœ
œ
˜ Jš
œ5˜5Jšœ
˜—K˜K˜—šžœœ
œœ
œ
œœ˜hKšœœ˜Kš
œ1˜1šœœ
œ
˜ Jš
œ)˜)Jšœ
˜—K˜K˜——J˜Jšœ
˜—…—#Ξ49