Type1FontImpl.mesa
Copyright Ó 1990, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
Michael Plass, September 30, 1992 9:38 pm PDT
Doug Wyatt, June 10, 1993 11:44 am PDT
Russ Atkinson (RRA) October 28, 1993 2:14 am PDT
DIRECTORY
Ascii USING [BS, CR, FF, LF, SP, TAB],
Atom USING [MakeAtom, MakeAtomFromRefText],
Basics USING [BITXOR, BoundsCheck, LongNumber, RawBytes, UnsafeBlock],
ImagerBox USING [Box],
ImagerPath USING [CurveToProc, LineToProc, MoveToProc],
ImagerTransformation USING [Create, Transformation],
IO USING [GetChar, STREAM],
Real USING [PairToReal, PlusInfinity, RealException],
RefTab USING [Create, EachPairAction, Fetch, GetSize, Pairs, Ref, Store],
RefText USING [ObtainScratch, ReleaseScratch, ReserveChars],
Rope USING [FromRefText, ROPE],
SafeStorage USING [GetUntracedZone],
Type1Font,
Vector2 USING [VEC];
Type1FontImpl: CEDAR PROGRAM
IMPORTS Atom, Basics, ImagerTransformation, IO, Real, RefTab, RefText, Rope, SafeStorage
EXPORTS Type1Font
= BEGIN OPEN Type1Font;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
VEC: TYPE = Vector2.VEC;
Scanner
Support types
Class: TYPE = {
newLine, -- CR, LF, FF
space, -- SP, TAB
openParen, -- '(
closeParen, -- ')
openBracket, -- '[
closeBracket, -- ']
openAngle, -- '<
closeAngle, -- '>
openBrace, -- '{
closeBrace, -- '}
slash, -- '/
percent, -- '%
dot, -- '.
hash, -- '#
sign, -- '+, '-
digitOctal, -- IN ['0..'7]
digitOther, -- IN ['0..'9] (other than digitOctal)
letterE, -- 'E, 'e
letterHex, -- IN ['A..'F], IN ['a..'f] (other than letterE)
letterOther, -- IN ['A..'Z], IN ['a..'z] (other than letterE, letterHex)
backslash, -- '\
other -- everything else
};
WhiteSpace: TYPE = Class [newLine..space];
Special: TYPE = Class [openParen..percent];
Regular: TYPE = Class [dot..other];
DecimalDigit: TYPE = Class [digitOctal..digitOther]; -- ['0..'9]
HexDigit: TYPE = Class [digitOctal..letterHex]; -- ['0..'9], ['A..'F], ['a..'f]
RadixDigit: TYPE = Class [digitOctal..letterOther]; -- ['0..'9], ['A..'Z], ['a..'z]
ClassArray: TYPE = PACKED ARRAY CHAR OF Class;
Digit: TYPE = [0..36);
DigitArray: TYPE = PACKED ARRAY CHAR OF Digit;
EscapeArray: TYPE = PACKED ARRAY CHAR OF CHAR;
State: TYPE = {
empty, -- only whitespace so far
sign, -- + | -
int0, -- digit | int0 digit a valid integer (without sign)
int1, -- sign digit | int1 digit a valid integer (with sign)
real0, -- . | sign .
real1, -- ( int0 | int1 ) . | real0 digit | real1 digit a valid real (without exponent)
real2, -- ( int0 | int1 | real1 ) ( e | E )
real3, -- real2 ( + | - )
real4, -- ( real2 | real3 ) digit | real4 digit a valid real (with exponent)
radix0, -- int0 #
radix1, -- radix0 rdigit | radix1 rdigit a valid radix number
name, -- char | name char a name
nameLit, -- / | nameLit char a literal name
string, -- ( ...
esc0, -- ( ... \
esc1, -- ( ... \d
esc2, -- ( ... \dd
hex0, -- < ... even number of digits
hex1, -- < ... odd number of digits
comment, -- % ...
special, -- { | } | [ | ]
error -- syntax error
};
Action: TYPE = {
skip, -- ignore char
append, -- append char to text buffer
putBack, -- return char to input source and stop
parenOpen, -- increment paren count and include char in string literal
parenClose, -- if paren count=0, stop; else decrement paren count and include char
escapeChar, -- translate escape char following '\
escapeDigit, -- include another octal digit in escape sequence
hexDigit1, -- char is first hex digit
hexDigit2, -- char is second hex digit, append byte
hexFill -- use zero for missing second digit, append byte, and stop
};
TransitionResult: TYPE = PACKED RECORD [
state: State,
action: Action,
stop: BOOL ¬ FALSE
];
TransitionTable: TYPE = ARRAY State OF REF TransitionArray ¬ ALL[NIL];
TransitionArray: TYPE = PACKED ARRAY Class OF TransitionResult;
RClass: TYPE = {
digit, -- IN ['0..'9]
sign, -- '+, '-
dot, -- '.
letterE, -- 'E, 'e
other -- everything else
};
RClassArray: TYPE = PACKED ARRAY CHAR OF RClass;
RState: TYPE = {
empty, -- beginning
msign, -- + | -
int, -- ( empty | msign | int ) digit integer part
dot, -- ( empty | msign ) .
idot, -- int .
frac, -- ( dot | idot | frac ) digit fraction part
epref, -- ( int | idot | frac ) ( e | E )
esign, -- epref ( + | - )
exp, -- ( epref | esign | exp ) digit exponent part
error
};
RTransitionTable: TYPE = ARRAY RState OF REF RTransitionArray ¬ ALL[NIL];
RTransitionArray: TYPE = PACKED ARRAY RClass OF RState;
Global variables
classFromChar: REF ClassArray = InitClassArray[];
digit: REF DigitArray = InitDigitArray[];
escape: REF EscapeArray = InitEscapeArray[];
transition: REF TransitionTable = InitTransitionTable[];
rclassFromChar: REF RClassArray = RClassInit[];
rtransition: REF RTransitionTable = RTransitionInit[];
Support procedures
InvalidFont: PUBLIC ERROR ~ CODE;
InitClassArray: PROC RETURNS [array: REF ClassArray ¬ NIL] = {
array ¬ NEW[ClassArray];
FOR char: CHAR IN CHAR DO
array[char] ¬ SELECT char FROM
Ascii.CR, Ascii.LF, Ascii.FF => newLine,
Ascii.SP, Ascii.TAB => space,
'( => openParen,
') => closeParen,
'[ => openBracket,
'] => closeBracket,
'< => openAngle,
'> => closeAngle,
'{ => openBrace,
'} => closeBrace,
'/ => slash,
'% => percent,
'. => dot,
'# => hash,
'+, '- => sign,
IN ['0..'7] => digitOctal,
IN ['0..'9] => digitOther,
'E, 'e => letterE,
IN ['A..'F], IN ['a..'f] => letterHex,
IN ['A..'Z], IN ['a..'z] => letterOther,
'\\ => backslash,
ENDCASE => other;
ENDLOOP;
};
InitDigitArray: PROC RETURNS [array: REF DigitArray ¬ NIL] = {
array ¬ NEW[DigitArray];
FOR char: CHAR IN CHAR DO
array[char] ¬ SELECT char FROM
IN ['0..'9] => char - '0,
IN ['A..'Z] => 10 + (char - 'A),
IN ['a..'z] => 10 + (char - 'a),
ENDCASE => 0;
ENDLOOP;
};
InitEscapeArray: PROC RETURNS [array: REF EscapeArray ¬ NIL] = {
array ¬ NEW[EscapeArray];
FOR char: CHAR IN CHAR DO
array[char] ¬ SELECT char FROM
'n => Ascii.LF,
'r => Ascii.CR,
't => Ascii.TAB,
'b => Ascii.BS,
'f => Ascii.FF,
IN ['0..'7] => VAL[digit[char]],
ENDCASE => char;
ENDLOOP;
};
Transition: PROC [state: State, class: Class] RETURNS [TransitionResult] = {
SELECT state FROM
empty => {
IF class IN WhiteSpace THEN RETURN[[action: skip, state: empty]];
IF class IN Special THEN SELECT class FROM
percent => RETURN[[action: skip, state: comment]];
slash => RETURN[[action: skip, state: nameLit]];
openParen => RETURN[[action: skip, state: string]];
openAngle => RETURN[[action: skip, state: hex0]];
ENDCASE => RETURN[[action: append, state: special, stop: TRUE]];
};
IN [sign..nameLit] => {
IF class IN WhiteSpace THEN RETURN[[action: skip, state: state, stop: TRUE]];
IF class IN Special THEN RETURN[[action: putBack, state: state, stop: TRUE]];
};
IN [hex0..hex1] => {
IF class IN WhiteSpace THEN RETURN[[action: skip, state: state]];
};
ENDCASE;
SELECT state FROM
empty => SELECT class FROM
sign => RETURN[[action: append, state: sign]];
dot => RETURN[[action: append, state: real0]];
IN DecimalDigit => RETURN[[action: append, state: int0]];
ENDCASE => RETURN[[action: append, state: name]];
sign => SELECT class FROM
dot => RETURN[[action: append, state: real0]];
IN DecimalDigit => RETURN[[action: append, state: int1]];
ENDCASE => RETURN[[action: append, state: name]];
int0 => SELECT class FROM
dot => RETURN[[action: append, state: real1]];
letterE => RETURN[[action: append, state: real2]];
hash => RETURN[[action: append, state: radix0]];
IN DecimalDigit => RETURN[[action: append, state: int0]];
ENDCASE => RETURN[[action: append, state: name]];
int1 => SELECT class FROM
dot => RETURN[[action: append, state: real1]];
letterE => RETURN[[action: append, state: real2]];
IN DecimalDigit => RETURN[[action: append, state: int1]];
ENDCASE => RETURN[[action: append, state: name]];
real0 => SELECT class FROM
IN DecimalDigit => RETURN[[action: append, state: real1]];
ENDCASE => RETURN[[action: append, state: name]];
real1 => SELECT class FROM
letterE => RETURN[[action: append, state: real2]];
IN DecimalDigit => RETURN[[action: append, state: real1]];
ENDCASE => RETURN[[action: append, state: name]];
real2 => SELECT class FROM
sign => RETURN[[action: append, state: real3]];
IN DecimalDigit => RETURN[[action: append, state: real4]];
ENDCASE => RETURN[[action: append, state: name]];
real3 => SELECT class FROM
IN DecimalDigit => RETURN[[action: append, state: real4]];
ENDCASE => RETURN[[action: append, state: name]];
real4 => SELECT class FROM
IN DecimalDigit => RETURN[[action: append, state: real4]];
ENDCASE => RETURN[[action: append, state: name]];
radix0 => SELECT class FROM
IN RadixDigit => RETURN[[action: append, state: radix1]];
ENDCASE => RETURN[[action: append, state: name]];
radix1 => SELECT class FROM
IN RadixDigit => RETURN[[action: append, state: radix1]];
ENDCASE => RETURN[[action: append, state: name]];
name => RETURN[[action: append, state: name]];
nameLit => RETURN[[action: append, state: nameLit]];
string => SELECT class FROM
openParen => RETURN[[action: parenOpen, state: string]];
closeParen => RETURN[[action: parenClose, state: string]];
backslash => RETURN[[action: skip, state: esc0]];
ENDCASE => RETURN[[action: append, state: string]];
esc0 => SELECT class FROM
newLine => RETURN[[action: skip, state: string]];
digitOctal => RETURN[[action: escapeChar, state: esc1]];
ENDCASE => RETURN[[action: escapeChar, state: string]];
esc1 => SELECT class FROM
closeParen => RETURN[[action: parenClose, state: string]];
digitOctal => RETURN[[action: escapeDigit, state: esc2]];
ENDCASE => RETURN[[action: append, state: string]];
esc2 => SELECT class FROM
closeParen => RETURN[[action: parenClose, state: string]];
digitOctal => RETURN[[action: escapeDigit, state: string]];
ENDCASE => RETURN[[action: append, state: string]];
hex0 => SELECT class FROM
closeAngle => RETURN[[action: skip, state: hex0, stop: TRUE]];
IN HexDigit => RETURN[[action: hexDigit1, state: hex1]];
ENDCASE => RETURN[[action: skip, state: error, stop: TRUE]];
hex1 => SELECT class FROM
closeAngle => RETURN[[action: skip, state: hex1, stop: TRUE]];
IN HexDigit => RETURN[[action: hexDigit2, state: hex0]];
ENDCASE => RETURN[[action: skip, state: error, stop: TRUE]];
comment => SELECT class FROM
newLine => RETURN[[action: skip, state: empty]];
ENDCASE => RETURN[[action: skip, state: comment]];
ENDCASE => RETURN[[action: skip, state: error, stop: TRUE]];
};
InitTransitionTable: PROC RETURNS [table: REF TransitionTable ¬ NIL] = {
table ¬ NEW[TransitionTable];
FOR state: State IN State DO
array: REF TransitionArray = NEW[TransitionArray];
FOR class: Class IN Class DO
array[class] ¬ Transition[state, class];
ENDLOOP;
table[state] ¬ array;
ENDLOOP;
};
RClassInit: PROC RETURNS [array: REF RClassArray ¬ NIL] = {
array ¬ NEW[RClassArray];
FOR char: CHAR IN CHAR DO
array[char] ¬ SELECT char FROM
IN ['0..'9] => digit,
'+, '- => sign,
'. => dot,
'E, 'e => letterE,
ENDCASE => other;
ENDLOOP;
};
RTransition: PROC [state: RState, class: RClass] RETURNS [RState] = {
RETURN[
SELECT state FROM
empty => SELECT class FROM
digit => int,
sign => msign,
dot => dot,
ENDCASE => error,
msign => SELECT class FROM digit => int, dot => dot, ENDCASE => error,
int => SELECT class FROM
digit => int,
dot => idot,
letterE => epref,
ENDCASE => error,
dot => SELECT class FROM digit => frac, ENDCASE => error,
idot, frac => SELECT class FROM digit => frac, letterE => epref, ENDCASE => error,
epref => SELECT class FROM digit => exp, sign => esign, ENDCASE => error,
esign => SELECT class FROM digit => exp, ENDCASE => error,
exp => SELECT class FROM digit => exp, ENDCASE => error,
ENDCASE => error
];
};
RTransitionInit: PROC RETURNS [table: REF RTransitionTable ¬ NIL] = {
table ¬ NEW[RTransitionTable];
FOR state: RState IN RState DO
array: REF RTransitionArray = NEW[RTransitionArray];
FOR class: RClass IN RClass DO
array[class] ¬ RTransition[state, class];
ENDLOOP;
table[state] ¬ array;
ENDLOOP;
};
Tokens
GetHexDigit: PROC [stream: STREAM] RETURNS [Digit] ~ {
DO
c: CHAR ~ IO.GetChar[stream];
IF classFromChar[c] IN HexDigit THEN RETURN[digit[c]];
ENDLOOP;
};
GetChar: PUBLIC PROC [s: Source] RETURNS [CHAR] ~ {
IF s.putBack THEN { s.putBack ¬ FALSE; RETURN[s.putBackChar] };
SELECT s.cipher FROM
plain => RETURN[IO.GetChar[s.stream]];
binary => RETURN[Decrypt1[s.key, IO.GetChar[s.stream]]];
hex => {
d0: Digit ~ GetHexDigit[s.stream];
d1: Digit ~ GetHexDigit[s.stream];
RETURN[Decrypt1[s.key, VAL[d0*16+d1]]];
};
ENDCASE => ERROR;
};
PutBack: PUBLIC PROC [s: Source, c: CHAR] ~ {
IF s.putBack THEN ERROR;
s.putBack ¬ TRUE;
s.putBackChar ¬ c;
};
GetToken: PUBLIC PROC [s: Source] RETURNS [Token] = {
text: REF TEXT ¬ s.buffer;
maxlength: NAT ¬ text.maxLength;
length: NAT ¬ 0; -- text length
state: State ¬ empty;
parens: CARDINAL ¬ 0; -- level of unbalanced parentheses within a string
DO -- for each character
char: CHAR ~ GetChar[s];
class: Class ~ classFromChar[char];
result: TransitionResult ~ transition[state][class];
achar: CHAR ¬ char; -- character to append to text
state ¬ result.state;
{
SELECT result.action FROM
skip => GOTO Skip;
append => NULL;
putBack => { PutBack[s, char]; GOTO Skip };
parenOpen => parens ¬ parens+1;
parenClose => IF parens>0 THEN parens ¬ parens-1 ELSE EXIT;
escapeChar => achar ¬ escape[char];
escapeDigit => achar ¬ VAL[ORD[text[length ¬ length-1]]*8+digit[char]];
hexDigit1 => achar ¬ VAL[digit[char]*16];
hexDigit2 => achar ¬ VAL[ORD[text[length ¬ length-1]]+digit[char]];
ENDCASE => ERROR InvalidFont;
IF NOT length<maxlength THEN {
text.length ¬ length;
text ¬ RefText.ReserveChars[to: text, nChars: 4];
maxlength ¬ text.maxLength;
};
text[length] ¬ achar;
length ¬ LOOPHOLE[length+1, NAT];
EXITS Skip => NULL;
};
IF result.stop THEN EXIT;
ENDLOOP;
text.length ¬ length;
SELECT state FROM
empty, comment => RETURN [[null, NIL]];
int0, int1 => RETURN [[int, text, TRUE]];
real1, real4 => RETURN [[real, text, TRUE]];
radix1 => RETURN [[radix, text, TRUE]];
string, hex0, hex1 => RETURN [[string, text, TRUE]];
nameLit => RETURN [[name, text, TRUE]];
special => RETURN [[special, text]];
error => ERROR InvalidFont;
ENDCASE => RETURN [[name, text]];
};
CardFromText: PROC [text: REF TEXT, start: NAT ¬ 0, radix: NAT ¬ 10] RETURNS [CARD] = {
limit: CARD ~ CARD.LAST / radix;
val: CARD ¬ 0;
IF radix NOT IN [2..36] THEN GOTO Bogus;
FOR i: NAT IN [start..text.length) DO
char: CHAR = text[i];
d: Digit = digit[char];
IF NOT d < radix THEN GOTO Bogus;
IF val > limit THEN GOTO Bogus ELSE val ¬ val * radix;
IF d > (CARD.LAST - val) THEN GOTO Bogus ELSE val ¬ val + d;
ENDLOOP;
RETURN [val];
EXITS Bogus => ERROR InvalidFont;
};
IntFromText: PROC [text: REF TEXT] RETURNS [INT] = {
SELECT text[0] FROM
'+ => RETURN[CardFromText[text, 1]];
'- => RETURN[-CardFromText[text, 1]];
ENDCASE => RETURN[CardFromText[text, 0]];
};
RadixFromText: PROC [text: REF TEXT] RETURNS [INT] = {
radix: NAT ¬ 0;
FOR i: NAT IN[0..text.length) DO
char: CHAR ~ text[i];
SELECT char FROM
IN['0..'9] => { radix ¬ radix * 10 + digit[char]; IF radix>36 THEN EXIT };
'# => RETURN[LOOPHOLE[CardFromText[text: text, start: i+1, radix: radix], INT]];
ENDCASE => EXIT;
ENDLOOP;
ERROR InvalidFont;
};
RealFromText: PROC [text: REF TEXT] RETURNS [REAL] = {
state: RState ¬ empty;
fr: INT ¬ 0; -- mantissa
exp, adj: INTEGER ¬ 0; -- exponent and adjustment
mNeg, eNeg: BOOL ¬ FALSE;
mDigits, eDigits: NAT ¬ 0; -- significant digits
real: REAL;
FOR i: NAT IN [0..text.length) DO
char: CHAR = text[i];
state ¬ rtransition[state][rclassFromChar[char]];
SELECT state FROM
msign => mNeg ¬ (char = '-);
int, frac => {
d: [0..10) = char - '0;
IF state = frac THEN adj ¬ adj - 1;
IF mDigits = 0 AND d = 0
THEN NULL -- leading zero
ELSE
IF mDigits < 9
THEN {fr ¬ fr * 10 + d; mDigits ¬ mDigits + 1}
ELSE {adj ¬ adj + 1; IF mDigits = 9 AND d > 5 THEN fr ¬ fr + 1; }; -- round if 10th digit >5
};
esign => eNeg ¬ (char = '-);
exp => {
d: [0..10) = char - '0;
IF eDigits = 0 AND d = 0
THEN NULL -- leading zero
ELSE IF eDigits < 3 THEN {exp ¬ exp * 10 + d; eDigits ¬ eDigits + 1};
};
error => GOTO Fail;
ENDCASE;
ENDLOOP;
SELECT state FROM
int, idot, frac, exp => NULL; -- ok
ENDCASE => GOTO Fail;
IF mNeg THEN fr ¬ -fr;
IF eNeg THEN exp ¬ -exp;
real ¬ Real.PairToReal[fr: fr, exp10: exp + adj !
Real.RealException =>
SELECT TRUE FROM
flags[overflow] => GOTO Big;
flags[underflow] => GOTO Little;
ENDCASE => GOTO Fail
];
RETURN[real];
EXITS
Big => RETURN[Real.PlusInfinity];
Little => RETURN[0.0];
Fail => ERROR InvalidFont;
};
GetKeyword: PUBLIC PROC [s: Source] RETURNS [ATOM] ~ {
nest: NAT ¬ 0;
DO
token: Token ~ GetToken[s];
IF token.type=special THEN SELECT token.text[0] FROM
'{, '[ => { nest ¬ nest+1; LOOP };
'}, '] => IF nest>0 THEN { nest ¬ nest-1; LOOP };
ENDCASE;
IF nest=0 THEN SELECT token.type FROM
name => RETURN[Atom.MakeAtomFromRefText[token.text]];
ENDCASE => RETURN[NIL];
ENDLOOP;
};
SkipToKeyword: PROC [s: Source, keyword: ATOM] ~ {
DO IF GetKeyword[s]=keyword THEN EXIT ENDLOOP;
};
GetIntBeforeKeyword: PROC [s: Source, key: ATOM] RETURNS [val: INT ¬ 0] ~ {
nest: NAT ¬ 0;
DO
token: Token ~ GetToken[s];
IF token.type=special THEN SELECT token.text[0] FROM
'{, '[ => { nest ¬ nest+1; LOOP };
'}, '] => IF nest>0 THEN { nest ¬ nest-1; LOOP };
ENDCASE;
IF nest=0 THEN SELECT token.type FROM
int, radix => val ¬ IntFromToken[token];
name => IF Atom.MakeAtomFromRefText[token.text]=key THEN RETURN;
ENDCASE;
ENDLOOP;
};
GetIntAfterKeyword: PROC [s: Source, key: ATOM] RETURNS [INT] ~ {
SkipToKeyword[s, key];
RETURN[GetInt[s]];
};
GetString: PROC [s: Source] RETURNS [ROPE] ~ {
token: Token ~ GetToken[s];
SELECT token.type FROM
string => RETURN[Rope.FromRefText[token.text]];
ENDCASE => ERROR InvalidFont;
};
GetName: PROC [s: Source] RETURNS [ATOM] ~ {
token: Token ~ GetToken[s];
SELECT token.type FROM
name => RETURN[Atom.MakeAtomFromRefText[token.text]];
ENDCASE => ERROR InvalidFont;
};
IntFromToken: PROC [token: Token] RETURNS [INT] ~ {
SELECT token.type FROM
int => RETURN[IntFromText[token.text]];
radix => RETURN[RadixFromText[token.text]];
ENDCASE => ERROR InvalidFont;
};
GetInt: PROC [s: Source] RETURNS [INT] ~ {
RETURN[IntFromToken[GetToken[s]]];
};
RealFromToken: PROC [token: Token] RETURNS [REAL] ~ {
SELECT token.type FROM
int => RETURN[IntFromText[token.text]];
radix => RETURN[RadixFromText[token.text]];
real => RETURN[RealFromText[token.text]];
ENDCASE => ERROR InvalidFont;
};
GetReal: PROC [s: Source] RETURNS [REAL] ~ {
RETURN[RealFromToken[GetToken[s]]];
};
GetBool: PROC [s: Source] RETURNS [BOOL] ~ {
SELECT GetName[s] FROM
$true => RETURN[TRUE];
$false => RETURN[FALSE];
ENDCASE => ERROR InvalidFont;
};
Decryption
c1: CARD16 ~ 52845;
c2: CARD16 ~ 22719;
ekey: CARD16 ~ 55665;
ckey: CARD16 ~ 4330;
Decrypt1: PUBLIC PROC [key: Key, char: CHAR] RETURNS [CHAR] ~ {
cipher: BYTE ~ ORD[char];
plain: BYTE ~ Basics.BITXOR[cipher, key.r/256];
key.r ¬ ((cipher+key.r)*c1+c2) MOD (2**16);
RETURN [VAL[plain]];
};
BeginEExec: PUBLIC PROC [s: Source] ~ {
i: NAT ¬ 0;
a: ARRAY [0..4) OF CHAR;
nonhex: BOOL ¬ FALSE;
s.key ¬ NEW[KeyRep ¬ [r: ekey]];
WHILE i<4 DO
char: CHAR ~ GetChar[s];
class: Class ~ classFromChar[char];
IF NOT (i=0 AND class IN WhiteSpace) THEN {
a[i] ¬ char; i ¬ i+1;
IF class NOT IN HexDigit THEN nonhex ¬ TRUE;
};
ENDLOOP;
IF nonhex THEN {
FOR i: NAT IN[0..4) DO [] ¬ Decrypt1[s.key, a[i]] ENDLOOP; -- cipher bytes 0-3
s.cipher ¬ binary;
}
ELSE {
d: ARRAY [0..4) OF Digit;
FOR i: NAT IN[0..4) DO d[i] ¬ digit[a[i]] ENDLOOP;
[] ¬ Decrypt1[s.key, VAL[d[0]*16+d[1]]]; -- cipher byte 0
[] ¬ Decrypt1[s.key, VAL[d[2]*16+d[3]]]; -- cipher byte 1
s.cipher ¬ hex;
THROUGH [0..2) DO [] ¬ GetChar[s] ENDLOOP; -- cipher bytes 2-3
};
};
Parser
untracedZone: ZONE ~ GetUZone[];
GetUZone: PROC RETURNS [ZONE] ~ TRUSTED { RETURN[SafeStorage.GetUntracedZone[]] };
String: TYPE ~ REF StringRep;
StringRep: TYPE ~ RECORD [PACKED SEQUENCE length: NAT OF BYTE];
GetBlockFromString: PROC [data: REF] RETURNS [Basics.UnsafeBlock] ~ {
string: String ~ NARROW[data];
RETURN[[
base: LOOPHOLE[string],
startIndex: BYTES[StringRep[0]],
count: string.length
]];
};
CharStringFromString: PROC [string: String] RETURNS [CharString] ~ {
RETURN[[data: string, getBlock: GetBlockFromString]];
};
SubrsArray: TYPE ~ REF SubrsArrayRep;
SubrsArrayRep: TYPE ~ RECORD [SEQUENCE length: NAT OF String];
CharStringsDict: TYPE ~ RefTab.Ref; -- TABLE ATOM OF String
Metrics2Dict: TYPE ~ RefTab.Ref; -- TABLE ATOM OF REF Metrics2
SpecialFromToken: PROC [token: Token] RETURNS [CHAR] ~ {
SELECT token.type FROM
special => RETURN[token.text[0]];
ENDCASE => ERROR InvalidFont;
};
Delim: TYPE ~ {bracket, brace};
OpenFromToken: PROC [token: Token] RETURNS [Delim] ~ {
open: Delim ~ SELECT SpecialFromToken[token] FROM
'[ => bracket, '{ => brace, ENDCASE => ERROR InvalidFont;
RETURN[open];
};
CloseFromToken: PROC [token: Token, open: Delim] ~ {
close: Delim ~ SELECT SpecialFromToken[token] FROM
'] => bracket, '} => brace, ENDCASE => ERROR InvalidFont;
IF open#close THEN ERROR InvalidFont;
};
GetOpenDelim: PROC [s: Source] RETURNS [Delim] ~ {
RETURN[OpenFromToken[GetToken[s]]];
};
GetCloseDelim: PROC [s: Source, open: Delim] ~ {
CloseFromToken[GetToken[s], open];
};
GetMatrix: PROC [s: Source] RETURNS [ImagerTransformation.Transformation] ~ {
Index: TYPE ~ [0..6); v: ARRAY Index OF REAL;
open: Delim ~ GetOpenDelim[s];
FOR i: Index IN Index DO v[i] ¬ GetReal[s] ENDLOOP;
GetCloseDelim[s, open];
RETURN[ImagerTransformation.Create[v[0], v[2], v[4], v[1], v[3], v[5]]];
};
GetBBox: PROC [s: Source] RETURNS [ImagerBox.Box] ~ {
Index: TYPE ~ [0..4); v: ARRAY Index OF REAL;
open: Delim ~ GetOpenDelim[s];
FOR i: Index IN Index DO v[i] ¬ GetReal[s] ENDLOOP;
GetCloseDelim[s, open];
RETURN[[xmin: v[0], ymin: v[1], xmax: v[2], ymax: v[3]]];
};
GetStdW: PROC [s: Source] RETURNS [REAL] ~ {
open: Delim ~ GetOpenDelim[s];
v: REAL ~ GetReal[s];
GetCloseDelim[s, open];
RETURN[v];
};
GetArray: PROC [s: Source] RETURNS [array: RealArray] ~ {
v: ARRAY [0..14) OF REAL; length: NAT ¬ 0;
open: Delim ~ GetOpenDelim[s];
DO
token: Token ~ GetToken[s];
IF token.type=special THEN { CloseFromToken[token, open]; EXIT }
ELSE { v[length] ¬ RealFromToken[token]; length ¬ length+1 };
ENDLOOP;
array ¬ NEW[RealArrayRep[length]];
FOR i: NAT IN[0..length) DO array[i] ¬ v[i] ENDLOOP;
};
theStandardEncoding: PUBLIC EncodingArray ~ NEW[EncodingArrayRep ¬ [
NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL,
NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL,
NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL,
NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL,
$space, $exclam, $quotedbl, $numbersign, $dollar, $percent, $ampersand, $quoteright,
$parenleft, $parenright, $asterisk, $plus, $comma, $hyphen, $period, $slash,
$zero, $one, $two, $three, $four, $five, $six, $seven,
$eight, $nine, $colon, $semicolon, $less, $equal, $greater, $question,
$at, $A, $B, $C, $D, $E, $F, $G,
$H, $I, $J, $K, $L, $M, $N, $O,
$P, $Q, $R, $S, $T, $U, $V, $W,
$X, $Y, $Z, $bracketleft, $backslash, $bracketright, $asciicircum, $underscore,
$quoteleft, $a, $b, $c, $d, $e, $f, $g,
$h, $i, $j, $k, $l, $m, $n, $o,
$p, $q, $r, $s, $t, $u, $v, $w,
$x, $y, $z, $braceleft, $bar, $braceright, $asciitilde, NIL,
NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL,
NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL,
NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL,
NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL,
NIL, $exclamdown, $cent, $sterling, $fraction, $yen, $florin, $section,
$currency, $quotesingle, $quotedblleft, $guillemotleft, $guilsinglleft, $guilsinglright, $fi, $fl,
NIL, $endash, $dagger, $daggerdbl, $periodcentered, NIL, $paragraph, $bullet,
$quotesinglbase, $quotedblbase, $quotedblright, $guillemotright, $ellipsis, $perthousand, NIL, $questiondown,
NIL, $grave, $acute, $circumflex, $tilde, $macron, $breve, $dotaccent,
$dieresis, NIL, $ring, $cedilla, NIL, $hungarumlaut, $ogonek, $caron,
$emdash, NIL, NIL, NIL, NIL, NIL, NIL, NIL,
NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL,
NIL, $AE, NIL, $ordfeminine, NIL, NIL, NIL, NIL,
$Lslash, $Oslash, $OE, $ordmasculine, NIL, NIL, NIL, NIL,
NIL, $ae, NIL, NIL, NIL, $dotlessi, NIL, NIL,
$lslash, $oslash, $oe, $germandbls, NIL, NIL, NIL, NIL
]];
ReadEncoding: PROC [s: Source] RETURNS [EncodingArray] ~ {
IF GetKeyword[s]=$StandardEncoding
THEN RETURN[theStandardEncoding]
ELSE {
array: EncodingArray ~ NEW[EncodingArrayRep];
DO
SELECT GetKeyword[s] FROM
$dup => {
index: BYTE ~ GetInt[s];
name: ATOM ~ GetName[s];
array[VAL[index]] ¬ name;
};
$readonly, $def => EXIT;
ENDCASE;
ENDLOOP;
RETURN[array];
};
};
ReadCharString: PROC [s: Source] RETURNS [string: String] ~ {
consumes <n> RD ~n~binary~bytes~
n: NAT ~ GetInt[s]; -- <n>
[] ¬ GetName[s]; -- RD
string ¬ untracedZone.NEW[StringRep[n]];
FOR i: NAT IN[0..n) DO string[i] ¬ ORD[GetChar[s]] ENDLOOP;
};
The Subrs section has one of the following forms:
Normal font:
/Subrs <length> array
dup <index> <n> RD <charstring> noaccess put
dup <index> <n> RD <charstring> noaccess put
...
dup <index> <n> RD <charstring> noaccess put
noaccess def
Hybrid font:
hires {userdict /fsmkr save put} if
/Subrs <length> array
dup <index> <n> RD <charstring> noaccess put
dup <index> <n> RD <charstring> noaccess put
...
dup <index> <n> RD <charstring> noaccess put
noaccess def
hires {fsmkr restore} {userdict /fsmkr save put} ifelse
/Subrs <length> array
dup <index> <n> RD <charstring> noaccess put
dup <index> <n> RD <charstring> noaccess put
...
dup <index> <n> RD <charstring> noaccess put
noaccess def
hires not {fsmkr restore} if
ReadSubrs is called when the first instance of /Subrs is encountered. ReadSubrsInner searches for <length> array. Recall that the <charstrings> can contain arbitrary bytes, so we must use ReadSubrsInner to skip the unwanted routines. Just trying to skip to the last 'hires' token will break the lexical scanner.
ReadSubrsInner: PROC [s: Source] RETURNS [SubrsArray] ~ {
length: NAT ~ GetIntBeforeKeyword[s, $array];
array: SubrsArray ~ NEW[SubrsArrayRep[length]];
FOR i: NAT IN[0..length) DO
index: NAT ~ GetIntAfterKeyword[s, $dup]; -- ... dup <index>
array[index] ¬ ReadCharString[s]; -- <n> RD ~n~binary~bytes~
ENDLOOP;
RETURN[array];
};
ReadSubrs: PROC [s: Source, hybrid: BOOL] RETURNS [array: SubrsArray] ~ {
array ¬ ReadSubrsInner[s];
IF hybrid THEN [] ¬ ReadSubrsInner[s];
};
ReadFontInfo: PROC [s: Source, self: Type1Data] ~ {
DO
SELECT GetKeyword[s] FROM
$version => self.version ¬ GetString[s];
$Notice => self.Notice ¬ GetString[s];
$FullName => self.FullName ¬ GetString[s];
$FamilyName => self.FamilyName ¬ GetString[s];
$Weight => self.Weight ¬ GetString[s];
$ItalicAngle => self.ItalicAngle ¬ GetReal[s];
$isFixedPitch => self.isFixedPitch ¬ GetBool[s];
$UnderlinePosition => self.UnderlinePosition ¬ GetReal[s];
$UnderlineThickness => self.UnderlineThickness ¬ GetReal[s];
$end => EXIT;
ENDCASE;
ENDLOOP;
};
The CharStrings section has one of the following forms:
Normal font:
/CharStrings <count> dict dup begin
<name> <n> RD <charstring> ND
...
end
Hybrid font:
/CharStrings
hires {userdict /fsmkr save put} if
<count> dict dup begin
<name> <n> RD <charstring> ND
...
end
hires {pop fsmkr restore} {userdict /fsmkr save put} ifelse
<count> dict dup begin
<name> <n> RD <charstring> ND
...
end
hires not {pop fsmkr restore} if
Hybrid font (alternate):
hires {userdict /fsmkr save put} if
/CharStrings <count> dict dup begin
<name> <n> RD <charstring> ND
...
end
hires {pop fsmkr restore} {userdict /fsmkr save put} ifelse
/CharStrings <count> dict dup begin
<name> <n> RD <charstring> ND
...
end
hires not {pop fsmkr restore} if
ReadCharStrings is called when the first instance of /CharStrings is encountered. ReadCharStringsInner searches for <count> dict.
ReadCharStringsInner: PROC [s: Source] RETURNS [dict: CharStringsDict] ~ {
count: NAT ~ GetIntBeforeKeyword[s, $dict];
dict ¬ RefTab.Create[count];
SkipToKeyword[s, $begin];
DO
name: ATOM ~ GetName[s]; -- <name> or end
IF name=$end THEN EXIT
ELSE {
[] ¬ RefTab.Store[dict, name, ReadCharString[s]]; -- <n> RD <charstring>
[] ¬ GetName[s]; -- ND
};
ENDLOOP;
};
ReadCharStrings: PROC [s: Source, hybrid: BOOL] RETURNS [dict: CharStringsDict] ~ {
dict ¬ ReadCharStringsInner[s];
IF hybrid THEN [] ¬ ReadCharStringsInner[s];
};
ReadMetrics2: PROC [s: Source] RETURNS [dict: Metrics2Dict] ~ {
This routine assumes following description pattern of Metrics2:
/Metrics2 95 dict dup begin
/c21 [0 -500 250 880 ] def
/c22 [0 -500 250 880 ] def
. . .
/.notdef [0 -500 250 880 ] def
end def
count: NAT ~ GetIntBeforeKeyword[s, $dict];
dict ¬ RefTab.Create[count];
SkipToKeyword[s, $begin];
DO
name: ATOM ~ GetName[s];
IF name=$end THEN EXIT
ELSE {
[] ¬ RefTab.Store[dict, name, ReadMetrics2Entry[s]];
[] ¬ GetName[s]; -- ND
};
ENDLOOP;
};
ReadMetrics2Entry: PROC [s: Source] RETURNS [Metrics2Entry] ~ {
Index: TYPE ~ [0..4); v: ARRAY Index OF REAL;
open: Delim ~ GetOpenDelim[s];
FOR i: Index IN Index DO v[i] ¬ GetReal[s] ENDLOOP;
GetCloseDelim[s, open];
RETURN[untracedZone.NEW[Metrics2EntryRep ← [w: [v[0], v[1]], v: [v[2], v[3]]]]];
};
Data: TYPE ~ REF DataRep;
DataRep: TYPE ~ RECORD [
subrs: SubrsArray ¬ NIL,
charStrings: CharStringsDict ¬ NIL,
metrics2: Metrics2Dict ¬ NIL
];
notdef: ATOM ~ Atom.MakeAtom[".notdef"];
CharStringsLength: PROC [self: Type1Data] RETURNS [NAT] ~ {
data: Data ~ NARROW[self.data];
RETURN[RefTab.GetSize[data.charStrings]];
};
CharStringsForAll: PROC [self: Type1Data, action: PROC [ATOM, CharString]] ~ {
data: Data ~ NARROW[self.data];
pairAction: RefTab.EachPairAction ~ {
name: ATOM ~ NARROW[key];
string: String ~ NARROW[val];
action[name, CharStringFromString[string]];
};
[] ¬ RefTab.Pairs[data.charStrings, pairAction];
};
CharStringsKnown: PROC [self: Type1Data, name: ATOM] RETURNS [BOOL] ~ {
data: Data ~ NARROW[self.data];
RETURN[RefTab.Fetch[data.charStrings, name].val#NIL];
};
CharStringsGet: PROC [self: Type1Data, name: ATOM] RETURNS [CharString] ~ {
data: Data ~ NARROW[self.data];
val: REF ¬ RefTab.Fetch[data.charStrings, name].val;
IF val=NIL THEN val ¬ RefTab.Fetch[data.charStrings, notdef].val;
WITH val SELECT FROM
string: String => RETURN[CharStringFromString[string]];
ENDCASE => ERROR InvalidFont;
};
SubrsGet: PROC [self: Type1Data, n: NAT] RETURNS [CharString] ~ {
data: Data ~ NARROW[self.data];
RETURN[CharStringFromString[data.subrs[n]]];
};
ParseFont: PUBLIC PROC [stream: STREAM] RETURNS [self: Type1Data] ~ {
buffer: REF TEXT ~ RefText.ObtainScratch[512];
s: Source ~ NEW[SourceRep ¬ [stream: stream, buffer: buffer]];
hybrid: BOOL ¬ FALSE;
data: Data ~ NEW[DataRep ¬ []];
self ¬ NEW[Type1DataRep ¬ [data: data,
CharStringsLength: CharStringsLength,
CharStringsForAll: CharStringsForAll,
CharStringsKnown: CharStringsKnown,
CharStringsGet: CharStringsGet,
SubrsGet: SubrsGet
]];
DO
SELECT GetKeyword[s] FROM
$FontInfo => ReadFontInfo[s, self]; -- FontInfo dict
$FontName => self.FontName ¬ GetName[s];
$Encoding => self.Encoding ¬ ReadEncoding[s];
$PaintType => self.PaintType ¬ GetInt[s];
$FontType => self.FontType ¬ GetInt[s];
$FontMatrix => self.FontMatrix ¬ GetMatrix[s];
$FontBBox => self.FontBBox ¬ GetBBox[s];
$UniqueID => self.UniqueID ¬ GetInt[s];
$StrokeWidth => self.StrokeWidth ¬ GetReal[s];
$Metrics2 => self.Metrics2 ¬ ReadMetrics2[s];
$eexec => BeginEExec[s];
$Private => EXIT;
ENDCASE;
ENDLOOP;
DO -- Private dict
SELECT GetKeyword[s] FROM
$hires => hybrid ¬ TRUE;
$Subrs => data.subrs ¬ ReadSubrs[s, hybrid];
$ForceBold => self.ForceBold ¬ GetBool[s];
$LanguageGroup => self.LanguageGroup ¬ GetInt[s];
$lenIV => self.lenIV ¬ GetInt[s];
$RndStemUp => self.RndStemUp ¬ GetBool[s];
$password => self.password ¬ GetInt[s];
$UniqueID => IF GetInt[s]#self.UniqueID THEN ERROR InvalidFont;
$BlueValues => self.BlueValues ¬ GetArray[s];
$OtherBlues => self.OtherBlues ¬ GetArray[s];
$FamilyBlues => self.FamilyBlues ¬ GetArray[s];
$FamilyOtherBlues => self.FamilyOtherBlues ¬ GetArray[s];
$BlueScale => self.BlueScale ¬ GetReal[s];
$BlueShift => self.BlueShift ¬ GetReal[s];
$BlueFuzz => self.BlueFuzz ¬ GetReal[s];
$StdHW => self.StdHW ¬ GetStdW[s];
$StdVW => self.StdVW ¬ GetStdW[s];
$StemSnapH => self.StemSnapH ¬ GetArray[s];
$StemSnapV => self.StemSnapV ¬ GetArray[s];
$MinFeature => self.MinFeature ← GetArray[s];
$CharStrings => EXIT;
ENDCASE;
ENDLOOP;
data.charStrings ¬ ReadCharStrings[s, hybrid]; -- CharStrings dict
RefText.ReleaseScratch[buffer];
};
CharString decoding
CStr: TYPE ~ RECORD [base: POINTER TO Basics.RawBytes, start, len, i: CARD, key: CARD16];
Num: TYPE ~ RECORD [SELECT tag: * FROM int => [x: INT], real => [x: REAL], ENDCASE];
DecodeCharString: PUBLIC PROC [block: Basics.UnsafeBlock, lenIV: NAT,
int: PROC [INT], cmd1: PROC [Cmd1], cmd2: PROC [Cmd2]] ~ {
cstr: CStr ¬ [base: block.base, start: block.startIndex, len: block.count, i: 0, key: ckey];
Get: PROC RETURNS [b: BYTE] ~ { c: BYTE; -- get next byte from charstring
TRUSTED { c ¬ cstr.base[cstr.start+Basics.BoundsCheck[cstr.i, cstr.len]] };
cstr.i ¬ cstr.i+1; b ¬ Basics.BITXOR[c, cstr.key/256];
cstr.key ¬ ((cstr.key+c)*c1+c2) MOD (2**16);
};
THROUGH [0..lenIV) DO [] ¬ Get[] ENDLOOP;
WHILE cstr.i<cstr.len DO v: BYTE ~ Get[]; SELECT v FROM
12 => cmd2[VAL[Get[]]];
<32 => cmd1[VAL[v]];
<247 => int[v-139]; -- [-107..107] (1 byte)
<251 => int[(v-247)*256+Get[]+108]; -- [108..1131] (2 bytes)
<255 => int[-((v-251)*256+Get[]+108)]; -- [-1131..-108] (2 bytes)
ENDCASE => { n: Basics.LongNumber; -- 32-bit signed integer (5 bytes)
n.hh ¬ Get[]; n.hl ¬ Get[]; n.lh ¬ Get[]; n.ll ¬ Get[]; int[n.int] };
ENDLOOP;
};
EncodingGet: PROC [self: Type1Data, code: BYTE] RETURNS [ATOM] ~ {
name: ATOM ~ self.Encoding[VAL[code]];
RETURN [IF name#NIL THEN name ELSE notdef];
};
StdEncodingGet: PROC [self: Type1Data, code: BYTE] RETURNS [ATOM] ~ {
name: ATOM ~ theStandardEncoding[VAL[code]];
RETURN [IF name#NIL THEN name ELSE notdef];
};
ExecuteChar: PUBLIC PROC [self: Type1Data, name: ATOM,
moveTo: MoveToProc, lineTo: LineToProc, curveTo: CurveToProc,
flex: FlexProc, close: CloseProc, hstem: HStemProc, hstem3: HStem3Proc,
vstem: VStemProc, vstem3: VStem3Proc, discard: DiscardProc, origin: VEC]
RETURNS [info: CharInfo ¬ [sb: [0,0], w: [0,0]]] ~ {
lenIV: NAT ~ self.lenIV;
cstr: CStr ¬ [NIL, 0, 0, 0, 0]; -- current charstring being executed
callers: ARRAY [0..10) OF CStr; -- charstring call stack
ci: NAT ¬ 0; -- call stack depth
Get: PROC RETURNS [b: BYTE] ~ { c: BYTE; -- get next byte from charstring
TRUSTED { c ¬ cstr.base[cstr.start+Basics.BoundsCheck[cstr.i, cstr.len]] };
cstr.i ¬ cstr.i+1; b ¬ Basics.BITXOR[c, cstr.key/256];
cstr.key ¬ ((cstr.key+c)*c1+c2) MOD (2**16);
};
Begin: PROC [cs: CharString] ~ { -- begin executing a charstring
block: Basics.UnsafeBlock ~ cs.getBlock[cs.data];
start: CARD ~ block.startIndex; len: CARD ~ block.count;
cstr ¬ [base: block.base, start: block.startIndex, len: block.count, i: 0, key: ckey];
THROUGH [0..lenIV) DO [] ¬ Get[] ENDLOOP;
};
stack: ARRAY [0..24) OF Num ¬ ALL[[int[0]]]; -- BuildChar operand stack
si: NAT ¬ 0; -- operand stack depth
I: PROC [k: NAT] RETURNS [INT] ~ { n: Num ~ stack[k];
RETURN[WITH n: n SELECT FROM int => n.x, ENDCASE => ERROR];
};
R: PROC [k: NAT] RETURNS [REAL] ~ { n: Num ~ stack[k];
RETURN[WITH n: n SELECT FROM int => n.x, real => n.x, ENDCASE => ERROR];
};
PutI: PROC [k: NAT, x: INT] ~ { stack[k] ¬ [int[x]]; };
PutR: PROC [k: NAT, x: REAL] ~ { stack[k] ¬ [real[x]]; };
PushI: PROC [x: INT] ~ INLINE { PutI[si, x]; si ¬ si+1 };
PushR: PROC [x: REAL] ~ INLINE { PutR[si, x]; si ¬ si+1 };
PopI: PROC RETURNS [INT] ~ INLINE { RETURN I[si ¬ si-1] };
PopR: PROC RETURNS [REAL] ~ INLINE { RETURN R[si ¬ si-1] };
weight: RealArray ~ self.WeightVector;
Blend: PROC [n: NAT, m: NAT] ~ {
k: NAT ~ n/m; -- n arguments, m results
FOR i: NAT IN[0..m) DO
si0: NAT ~ si+i; -- stack index of result
si1: NAT ~ si+m+(k-1)*i; -- stack index of first delta
val: REAL ¬ R[si0];
FOR j: NAT IN[1..k) DO val ¬ val+weight[j]*R[si1+j-1] ENDLOOP;
PutR[si0, val];
ENDLOOP;
};
flexing: BOOL ¬ FALSE; f: FlexArray ¬ ALL[[0,0]]; fi: NAT ¬ 0; -- for Flex
moveTo1: PROC [p: VEC] ~ INLINE { IF flexing THEN NULL ELSE moveTo[p] };
cp: VEC ¬ origin; -- current point
Begin[self.CharStringsGet[self, name]];
DO v: BYTE ~ Get[]; SELECT v FROM
<32 => { -- a command
clear: BOOL ¬ TRUE; -- most commands implicitly clear the stack
SELECT Cmd1[VAL[v]] FROM
hsbw => info ¬ [sb: (cp ¬ [origin.x+R[0], origin.y]), w: [R[1], 0]];
rmoveto => {
p1: VEC ~ [ cp.x+R[0], cp.y+R[1] ];
moveTo1[cp ¬ p1];
};
hmoveto => {
p1: VEC ~ [ cp.x+R[0], cp.y ];
moveTo1[cp ¬ p1];
};
vmoveto => {
p1: VEC ~ [ cp.x, cp.y+R[0] ];
moveTo1[cp ¬ p1];
};
rlineto => {
p1: VEC ~ [ cp.x+R[0], cp.y+R[1] ];
lineTo[cp ¬ p1];
};
hlineto => {
p1: VEC ~ [ cp.x+R[0], cp.y ];
lineTo[cp ¬ p1];
};
vlineto => {
p1: VEC ~ [ cp.x, cp.y+R[0] ];
lineTo[cp ¬ p1];
};
rrcurveto => {
p1: VEC ~ [ cp.x+R[0], cp.y+R[1] ];
p2: VEC ~ [ p1.x+R[2], p1.y+R[3] ];
p3: VEC ~ [ p2.x+R[4], p2.y+R[5] ];
curveTo[p1, p2, cp ¬ p3];
};
hvcurveto => {
p1: VEC ~ [ cp.x+R[0], cp.y ];
p2: VEC ~ [ p1.x+R[1], p1.y+R[2] ];
p3: VEC ~ [ p2.x, p2.y+R[3] ];
curveTo[p1, p2, cp ¬ p3];
};
vhcurveto => {
p1: VEC ~ [ cp.x, cp.y+R[0] ];
p2: VEC ~ [ p1.x+R[1], p1.y+R[2] ];
p3: VEC ~ [ p2.x+R[3], p2.y ];
curveTo[p1, p2, cp ¬ p3];
};
closepath => IF close#NIL THEN close[];
hstem => IF hstem#NIL THEN hstem[y: info.sb.y+R[0], dy: R[1]];
vstem => IF vstem#NIL THEN vstem[x: info.sb.x+R[0], dx: R[1]];
callsubr => { subr: NAT ~ PopI[]; callers[ci] ¬ cstr; ci ¬ ci+1;
Begin[self.SubrsGet[self, subr]]; clear ¬ FALSE };
return => { cstr ¬ callers[ci ¬ ci-1]; clear ¬ FALSE };
endchar => RETURN;
VAL[15] => { -- undocumented command: ignore and hope for the best -- };
escape => SELECT Cmd2[VAL[Get[]]] FROM
seac => {
RRA, October 28, 1993 1:42:35 am PDT
The Type1Font book (page 50) claims that seac should not work if the encoding vector differs from the standard encoding vector for the aname or bname, but we have evidence of a client who seems to assume the use of the standard encoding vector, even though the font encoding vector is ISO Latin (more or less).
asb: REAL ~ R[0]; adx: REAL ~ R[1]; ady: REAL ~ R[2];
bnameStd: ATOM ~ StdEncodingGet[self, VAL[I[3]]];
anameStd: ATOM ~ StdEncodingGet[self, VAL[I[4]]];
bname: ATOM ~ EncodingGet[self, VAL[I[3]]];
aname: ATOM ~ EncodingGet[self, VAL[I[4]]];
binfo: CharInfo ~ ExecuteChar[self, bnameStd, moveTo, lineTo, curveTo,
flex, close, hstem, hstem3, vstem, vstem3, discard, origin];
aorigin: VEC ~ [origin.x+binfo.sb.x-asb+adx, origin.y+ady];
The Type1Font book (page 50) claims that seac displaces the origin of the accent [adx, ady] from the origin of the base character, but we seem to get correct results by using sidebearing point, not origin.
IF discard#NIL THEN discard[]; -- new hints for the accent
[] ¬ ExecuteChar[self, anameStd, moveTo, lineTo, curveTo,
flex, close, hstem, hstem3, vstem, vstem3, discard, aorigin];
RETURN[binfo];
};
For reference, here is the old code
<<seac => {
asb: REAL ~ R[0]; adx: REAL ~ R[1]; ady: REAL ~ R[2];
bname: ATOM ~ EncodingGet[self, VAL[I[3]]];
aname: ATOM ~ EncodingGet[self, VAL[I[4]]];
binfo: CharInfo ~ ExecuteChar[self, bname, moveTo, lineTo, curveTo,
flex, close, hstem, hstem3, vstem, vstem3, discard, origin];
aorigin: VEC ~ [origin.x+binfo.sb.x-asb+adx, origin.y+ady];
The Type1Font book (page 50) claims that seac displaces the origin of the accent [adx, ady] from the origin of the base character, but we seem to get correct results by using sidebearing point, not origin.
IF discard#NIL THEN discard[]; -- new hints for the accent
[] ¬ ExecuteChar[self, aname, moveTo, lineTo, curveTo,
flex, close, hstem, hstem3, vstem, vstem3, discard, aorigin];
RETURN[binfo];
};>>
sbw => info ¬ [sb: cp ¬ [origin.x+R[0], origin.y+R[1]], w: [R[2], R[3]]];
div => { si ¬ si-2; PushR[R[si]/R[si+1]]; clear ¬ FALSE };
dotsection => { --ignored-- };
hstem3 => IF hstem3#NIL THEN hstem3[y0: info.sb.y+R[0], dy0: R[1],
y1: info.sb.y+R[2], dy1: R[3], y2: info.sb.y+R[4], dy2: R[5]];
vstem3 => IF vstem3#NIL THEN vstem3[x0: info.sb.x+R[0], dx0: R[1],
x1: info.sb.x+R[2], dx1: R[3], x2: info.sb.x+R[4], dx2: R[5]];
callothersubr => {
subr: NAT ~ PopI[];
n: NAT ~ PopI[];
si ¬ si-n; -- pop n arguments
SELECT subr FROM
0 => { -- end Flex
IF flex#NIL THEN flex[f: f, min: R[si]/100]
ELSE { curveTo[f[1], f[2], f[3]]; curveTo[f[4], f[5], f[6]] };
PutR[si, cp.x]; PutR[si+1, cp.y];
flexing ¬ FALSE;
};
1 => { fi ¬ 0; flexing ¬ TRUE }; -- begin Flex
2 => { f[fi] ¬ cp; fi ¬ fi+1 }; -- add Flex coordinates
3 => IF discard#NIL THEN discard[] ELSE PutI[si, 3]; -- hint replacement
14 => Blend[n, 1];
15 => Blend[n, 2];
16 => Blend[n, 3];
17 => Blend[n, 4];
18 => Blend[n, 6];
ENDCASE;
clear ¬ FALSE;
};
pop => { si ¬ si+1; clear ¬ FALSE };
setcurrentpoint => cp ¬ [R[0], R[1]];
ENDCASE => ERROR; -- unrecognized Cmd2
ENDCASE => ERROR; -- unrecognized Cmd1
IF clear THEN si ¬ 0;
};
<247 => PushI[v-139]; -- [-107..107] (1 byte)
<251 => PushI[(v-247)*256+Get[]+108]; -- [108..1131] (2 bytes)
<255 => PushI[-((v-251)*256+Get[]+108)]; -- [-1131..-108] (2 bytes)
ENDCASE => { x: Basics.LongNumber; -- 32-bit signed integer (5 bytes)
x.hh ¬ Get[]; x.hl ¬ Get[]; x.lh ¬ Get[]; x.ll ¬ Get[]; PushI[x.int] };
ENDLOOP;
};
END.