<> <> <> <<>> DIRECTORY Imager USING [ConcatT, Context, DoSave], ImagerFont USING [CorrectionType, Extents, Font, FontRep, nullXChar, XChar], ImagerFontPrivate USING [FontImpl, FontImplRep], ImagerTransformation USING [Scale, Transformation, TransformVec], ImagerTypeface USING [Typeface, TypefaceClass, TypefaceClassRep, TypefaceRep], IPImager, IPInterpreter, Vector2 USING [VEC]; IPTypefaceImpl: CEDAR PROGRAM IMPORTS Imager, ImagerTransformation, IPImager, IPInterpreter EXPORTS ImagerFont, IPImager ~ BEGIN OPEN IPInterpreter, ImagerTypeface, ImagerFont; VEC: TYPE ~ Vector2.VEC; Transformation: TYPE ~ ImagerTransformation.Transformation; Data: TYPE ~ REF DataRep; DataRep: TYPE ~ RECORD[ fontDescription: Vector, characterMasks: Vector, characterMetrics: Vector, transformation: Transformation, interpreter: Ref ]; Font: TYPE ~ ImagerFont.Font; FontRep: TYPE ~ ImagerFont.FontRep; FontImpl: TYPE ~ ImagerFontPrivate.FontImpl; FontImplRep: PUBLIC TYPE ~ ImagerFontPrivate.FontImplRep; -- export to ImagerFont identity: Transformation ~ ImagerTransformation.Scale[1]; MakeFont: PUBLIC PROC [self: Ref, v: Vector] RETURNS [Font] ~ { typeface: Typeface ~ IPCreate[self, v]; impl: FontImpl ~ NEW[FontImplRep _ [typeface: typeface]]; font: Font ~ NEW[FontRep _ [name: typeface.name, charToClient: identity, impl: impl]]; RETURN[font]; }; IPCreate: PROC [self: Ref, fd: Vector] RETURNS [Typeface] ~ { data: Data ~ NEW[DataRep _ []]; data.fontDescription _ fd; data.characterMasks _ VectorFromAny[GetPR[fd, "characterMasks"]]; data.characterMetrics _ VectorFromAny[GetPR[fd, "characterMetrics"]]; WITH GetPR[fd, "transformation"] SELECT FROM m: Transformation => data.transformation _ m; ENDCASE => ERROR; data.interpreter _ self; RETURN[NEW[TypefaceRep _ [class: ipClass, data: data]]]; }; IPContains: PROC [self: Typeface, char: XChar] RETURNS [BOOL] ~ { data: Data ~ NARROW[self.data]; i: Cardinal ~ LOOPHOLE[char, CARDINAL]; RETURN[GetPropC[data.characterMetrics, i].found]; }; IPNextChar: PROC [self: Typeface, char: XChar] RETURNS [next: XChar] ~ { ichar: CARDINAL ~ LOOPHOLE[char]; start: CARDINAL _ 0; IF char=nullXChar THEN start _ 0 ELSE IF ichar RETURN[mask]; 1 => RETURN[space]; ENDCASE; }; RETURN[none]; }; IPBoundingBox: PROC [self: Typeface, char: XChar] RETURNS [Extents] ~ { data: Data ~ NARROW[self.data]; found: BOOL; value: Any; [found, value] _ GetPropC[data.characterMetrics, LOOPHOLE[char, CARDINAL]]; IF found THEN { metrics: Vector ~ VectorFromAny[value]; extents: Extents _ [0, 0, 0, 0]; [found, value] _ GetPropR[metrics, "leftExtent"]; IF found THEN extents.leftExtent _ RealFromAny[value]; [found, value] _ GetPropR[metrics, "rightExtent"]; IF found THEN extents.rightExtent _ RealFromAny[value]; [found, value] _ GetPropR[metrics, "ascent"]; IF found THEN extents.ascent _ RealFromAny[value]; [found, value] _ GetPropR[metrics, "descent"]; IF found THEN extents.descent _ RealFromAny[value]; RETURN[extents]; }; RETURN[[0, 0, 0, 0]]; }; IPFontBoundingBox: PROC [self: Typeface] RETURNS [Extents] ~ { RETURN[[0, 0, 0, 0]]; }; IPKern: PROC [self: Typeface, char, successor: XChar] RETURNS [VEC] ~ { RETURN[[0, 0]]; }; IPNextKern: PROC [self: Typeface, char, successor: XChar] RETURNS [XChar] ~ { RETURN[nullXChar]; }; IPLigature: PROC [self: Typeface, char, successor: XChar] RETURNS [XChar] ~ { RETURN[nullXChar]; }; IPNextLigature: PROC [self: Typeface, char, successor: XChar] RETURNS [XChar] ~ { RETURN[nullXChar]; }; IPMask: PROC [self: Typeface, char: XChar, context: Imager.Context] ~ { data: Data ~ NARROW[self.data]; interpreter: IPInterpreter.Ref ~ data.interpreter; savedImager: Imager.Context ~ interpreter.imager; maskAction: PROC ~ { Imager.ConcatT[context, data.transformation]; IPImager.MaskChar[interpreter, data.fontDescription, LOOPHOLE[char, CARDINAL]]; }; interpreter.imager _ context; Imager.DoSave[context, maskAction ! UNWIND => interpreter.imager _ savedImager]; interpreter.imager _ savedImager; }; ipClass: TypefaceClass ~ NEW[TypefaceClassRep _ [ type: $IP, Contains: IPContains, NextChar: IPNextChar, Width: IPWidth, Amplified: IPAmplified, Correction: IPCorrection, BoundingBox: IPBoundingBox, FontBoundingBox: IPFontBoundingBox, Ligature: IPLigature, NextLigature: IPNextLigature, Kern: IPKern, NextKern: IPNextKern, Mask: IPMask ]]; END.