<> <> <> <> <> 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; <> <> 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; <> classFromChar: REF ClassArray = InitClassArray[]; digit: REF DigitArray = InitDigitArray[]; escape: REF EscapeArray = InitEscapeArray[]; transition: REF TransitionTable = InitTransitionTable[]; rclassFromChar: REF RClassArray = RClassInit[]; rtransition: REF RTransitionTable = RTransitionInit[]; <> 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; }; <> 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 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; }; <> 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 }; }; <> 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] ~ { < RD ~n~binary~bytes~>> n: NAT ~ GetInt[s]; -- [] ¬ GetName[s]; -- RD string ¬ untracedZone.NEW[StringRep[n]]; FOR i: NAT IN[0..n) DO string[i] ¬ ORD[GetChar[s]] ENDLOOP; }; <> <> < array dup RD noaccess put dup RD noaccess put ... dup RD noaccess put noaccess def >> <> < array dup RD noaccess put dup RD noaccess put ... dup RD noaccess put noaccess def hires {fsmkr restore} {userdict /fsmkr save put} ifelse /Subrs array dup RD noaccess put dup RD noaccess put ... dup RD noaccess put noaccess def hires not {fsmkr restore} if >> << ReadSubrs is called when the first instance of /Subrs is encountered. ReadSubrsInner searches for array. Recall that the 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 array[index] ¬ ReadCharString[s]; -- 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; }; <> <> < dict dup begin RD ND ... end >> <> < dict dup begin RD ND ... end hires {pop fsmkr restore} {userdict /fsmkr save put} ifelse dict dup begin RD ND ... end hires not {pop fsmkr restore} if >> <> < dict dup begin RD ND ... end hires {pop fsmkr restore} {userdict /fsmkr save put} ifelse /CharStrings dict dup begin RD ND ... end hires not {pop fsmkr restore} if >> << ReadCharStrings is called when the first instance of /CharStrings is encountered. ReadCharStringsInner searches for 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]; -- or end IF name=$end THEN EXIT ELSE { [] ¬ RefTab.Store[dict, name, ReadCharString[s]]; -- RD [] ¬ 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] ~ { <> <> <> <> << . . .>> <> <> 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]; }; <> 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 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 => { <> <> 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]; <> 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]; }; <> < { 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]; <> 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.