-- PressFontWidths.mesa, edit by Johnsson; July 9, 1980  2:09 PM
-- converted to Laurel by Ken Pier, July 30, 1981  9:17 AM 
-- fixed INTEGER[p] in ScaleThings, August 5, 1981  11:11 AM 
-- added FreeCacheEntry, August 10, 1981  5:10 PM 
-- converted to Laurel 6.1 by Ken Pier, May 17, 1983  10:39 AM

DIRECTORY
  InlineDefs USING [LongDiv, LongMult],
  Press USING [
    FontSlope, FontWeight, magicNonPrintingWidth, Mica,
    micasPerInch, Points, pointsPerInch],
  PressUtilities USING [],
  intCommon USING [user],
  PrintDefs USING[PError, DestroyS],
  Core: FROM "Core" USING [--FreeCacheEntry,--Login ],
  csD: FROM "CoreStreamDefs";

PressFontWidths: PROGRAM
  IMPORTS intCommon, PrintDefs, InlineDefs, csD, Core
  EXPORTS PressUtilities =
  BEGIN
  
  FontSlope: TYPE = Press.FontSlope;
  FontWeight: TYPE = Press.FontWeight;
  Mica: TYPE = Press.Mica;
  Points: TYPE = Press.Points;
  
  -- bug in us, or file in wrong format
  
  FontName: TYPE = PACKED ARRAY [0..20) OF BYTE;
  FontFace: TYPE = [0..2*3*3); -- this wasn't my idea
  
  BYTE: TYPE = [0..377B];
  
  -- see [MAXC]<Press>FontFormats.bravo
  -- if index.size=0, then numbers need to be scaled by points*2540/72000
  
  IX: TYPE = MACHINE DEPENDENT RECORD [type: [0..17B), length: [0..7777B]];
  IXN: TYPE = MACHINE DEPENDENT RECORD [e: IX, code: WORD, name: FontName];
  SDTIX: TYPE = MACHINE DEPENDENT RECORD [
    e: IX,
    code, face: BYTE,
    bc, ec: CHARACTER,
    size: Points,
    rotation: INTEGER,
    x1, location, x2, length: CARDINAL]; -- position in file
  
  WidthSegment: TYPE = MACHINE DEPENDENT RECORD [
    fBBox, fBBoy, fBBdx, fBBdy: WORD, xFeed, yFeed: BOOLEAN, xxx: [0..37777B]];
  
  ComputeFontFace: PROCEDURE [w: FontWeight, s: FontSlope]
    RETURNS [ff: FontFace] =
    BEGIN
    ff _ 0;
    SELECT w FROM
      medium => ff _ ff + 0;
      bold => ff _ ff + 2;
      --light => ff _ ff+4;
      
      ENDCASE => PrintDefs.PError[BadParameters];
    SELECT s FROM
      regular => ff _ ff + 0;
      italic => ff _ ff + 1;
      ENDCASE => PrintDefs.PError[BadParameters];
    --SELECT expansion FROM
    --  regular => ff _ ff+0;
    --  condensed => ff _ ff+6;
    --  expanded => ff _ ff+12;
    --  ENDCASE => PrintDefs.PError[BadParameters];
    
    END;
    
  FindFontWidths: PUBLIC PROCEDURE [
    family: STRING, points: Points, weight: FontWeight, slope: FontSlope,
    widths: POINTER TO ARRAY CHARACTER OF Mica]
    RETURNS [fBBox, fBBoy, fBBdx, fBBdy: Mica] =
    BEGIN
    
    ScaleThings: PROCEDURE [p: CARDINAL] RETURNS [Mica] =
      BEGIN OPEN InlineDefs;
      pp: INTEGER _ LOOPHOLE[p];
      IF pp = Press.magicNonPrintingWidth THEN RETURN[pp];
      IF index.size # 0 THEN RETURN[pp];
      -- This will overflow at about 200 points.
      IF p IN [0..77777B] THEN RETURN[LongDiv[LongMult[254*points, pp], 7200]];
      RETURN[-LongDiv[LongMult[254*points, -pp], 7200]];
      END;
      
    ff: FontFace = ComputeFontFace[weight, slope];
    i: CARDINAL;
    c: CHARACTER;
    code: WORD;
    nameFound, indexFound: BOOLEAN _ FALSE;
    pointSizeInMicas: Mica;
    name: FontName;
    e: IX;
    header: IXN;
    index: SDTIX;
    width: WidthSegment;
    x: WORD;

    s: csD.StreamHandle _ NIL;

    BEGIN ENABLE UNWIND => {s _ PrintDefs.DestroyS[s];};

    Core.Login[@intCommon.user];
    s _ csD.OpenFromName["Fonts.widths"L, word, read];
    --Core.FreeCacheEntry["Fonts.widths"L];--
    BEGIN OPEN InlineDefs; -- else overflows at about 25 points
    pointSizeInMicas _ LongDiv[
      LongMult[Press.micasPerInch, points], Press.pointsPerInch];
    END;

    -- copy over the family name into Fonts.Widths format
    IF family.length~ IN (0..19] THEN PrintDefs.PError[BadParameters];
    FOR i IN [0..20) DO name[i] _ 0; ENDLOOP;
    name[0] _ family.length;
    FOR i IN [0..family.length) DO
      SELECT family[i] FROM
	IN ['A..'Z] => name[i + 1] _ LOOPHOLE[family[i]];
	IN ['a..'z] => name[i + 1] _ LOOPHOLE[family[i], BYTE] - 40B;
	ENDCASE => PrintDefs.PError[BadParameters];
      ENDLOOP;
    DO
      IF csD.ReadBlock[s, @e, 0, SIZE[IX]] = 0
					THEN PrintDefs.PError[ErrorReadingFontWidths];
      SELECT e.type FROM
	0 => EXIT;
	1 =>
	  BEGIN
	  IF e.length # SIZE[IXN] THEN PrintDefs.PError[ErrorReadingFontWidths];
	  IF csD.ReadBlock[s, @header + 1, 0, SIZE[IXN] - 1] = 0 THEN
	    PrintDefs.PError[ErrorReadingFontWidths];
	  IF EqualName[@name, @header.name] THEN
	    BEGIN code _ header.code; nameFound _ TRUE; END;
	  END;
	4 =>
	  BEGIN
	  IF e.length # SIZE[SDTIX] THEN PrintDefs.PError[ErrorReadingFontWidths];
	  IF csD.ReadBlock[s, @index + 1, 0, SIZE[SDTIX] - 1] = 0 THEN
	    PrintDefs.PError[ErrorReadingFontWidths];
	  IF nameFound AND code = index.code AND ff = index.face AND
	   index.rotation = 0 AND (index.size = 0 OR INTEGER[index.size] =
	    pointSizeInMicas) THEN BEGIN indexFound _ TRUE; EXIT; END;
	  END;
	ENDCASE => PrintDefs.PError[ErrorReadingFontWidths];
      ENDLOOP;
    IF ~indexFound THEN PrintDefs.PError[FontNotInFontsDotWidths];
    IF index.x1 # 0 OR index.x2 # 0 THEN
								PrintDefs.PError[ErrorReadingFontWidths];
    -- position file to starting byte of our info
    csD.SetPosition[s, index.location];
    IF csD.ReadBlock[s, @width, 0, SIZE[WidthSegment]] = 0 THEN
      PrintDefs.PError[ErrorReadingFontWidths];
    fBBox _ ScaleThings[width.fBBox];
    fBBoy _ ScaleThings[width.fBBoy];
    fBBdx _ ScaleThings[width.fBBdx];
    fBBdy _ ScaleThings[width.fBBdy];
    IF width.xFeed THEN
      BEGIN
      x _ ScaleThings[csD.Read[s]];
      FOR c IN [index.bc..index.ec] DO widths[c] _ x; ENDLOOP;
      END
    ELSE
      BEGIN
      FOR c IN [index.bc..index.ec] DO widths[c] _ ScaleThings[csD.Read[s]]; ENDLOOP;
      END;
    s _ PrintDefs.DestroyS[s];
    END;-- of ENABLED BEGIN
    END;-- of PROC FindFontWidths
    
  EqualName: PROCEDURE [n1, n2: POINTER TO FontName] RETURNS [BOOLEAN] =
    BEGIN
    i: CARDINAL;
    FOR i IN [0..20) DO IF n1[i] # n2[i] THEN RETURN[FALSE]; ENDLOOP;
    RETURN[TRUE];
    END;
    
  
  END.

--Former Errors
  FontNotInFontsDotWidths: PUBLIC ERROR = CODE;
  ErrorReadingFontWidths: PUBLIC ERROR = CODE;