-- PressFontWidths.mesa, edit by Johnsson; July 9, 1980  2:09 PM

DIRECTORY
  InlineDefs USING [LongDiv, LongMult],
  Press USING [
    BadParameters, FontSlope, FontWeight, magicNonPrintingWidth, Mica,
    micasPerInch, Points, pointsPerInch],
  PressUtilities USING [],
  StreamDefs USING [NewWordStream, Read, ReadBlock, SetPosition, StreamHandle];

PressFontWidths: PROGRAM
  IMPORTS InlineDefs, Press, StreamDefs EXPORTS PressUtilities =
  BEGIN
  
  FontSlope: TYPE = Press.FontSlope;
  FontWeight: TYPE = Press.FontWeight;
  Mica: TYPE = Press.Mica;
  Points: TYPE = Press.Points;
  
  FontNotInFontsDotWidths: PUBLIC ERROR = CODE;
  ErrorReadingFontWidths: PUBLIC ERROR = CODE;
  -- 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 => ERROR Press.BadParameters;
    SELECT s FROM
      regular => ff _ ff + 0;
      italic => ff _ ff + 1;
      ENDCASE => ERROR Press.BadParameters;
    --SELECT expansion FROM
    --  regular => ff _ ff+0;
    --  condensed => ff _ ff+6;
    --  expanded => ff _ ff+12;
    --  ENDCASE => ERROR Press.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 OPEN StreamDefs;
    
    ScaleThings: PROCEDURE [p: CARDINAL] RETURNS [Mica] =
      BEGIN OPEN InlineDefs;
      IF INTEGER[p] = Press.magicNonPrintingWidth THEN RETURN[p];
      IF index.size # 0 THEN RETURN[p];
      -- This will overflow at about 200 points.
      IF p IN [0..77777B] THEN RETURN[LongDiv[LongMult[254*points, p], 7200]];
      RETURN[-LongDiv[LongMult[254*points, -p], 7200]];
      END;
      
    ff: FontFace = ComputeFontFace[weight, slope];
    i: CARDINAL;
    c: CHARACTER;
    code: WORD;
    nameFound, indexFound: BOOLEAN _ FALSE;
    pointSizeInMicas: Mica;
    name: FontName;
    s: StreamHandle _ NewWordStream["Fonts.widths", Read];
    e: IX;
    header: IXN;
    index: SDTIX;
    width: WidthSegment;
    x: WORD;
    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 ERROR Press.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 => ERROR Press.BadParameters;
      ENDLOOP;
    DO
      IF ReadBlock[s, @e, SIZE[IX]] = 0 THEN ERROR ErrorReadingFontWidths;
      SELECT e.type FROM
	0 => EXIT;
	1 =>
	  BEGIN
	  IF e.length # SIZE[IXN] THEN ERROR ErrorReadingFontWidths;
	  IF ReadBlock[s, @header + 1, SIZE[IXN] - 1] = 0 THEN
	    ERROR ErrorReadingFontWidths;
	  IF EqualName[@name, @header.name] THEN
	    BEGIN code _ header.code; nameFound _ TRUE; END;
	  END;
	4 =>
	  BEGIN
	  IF e.length # SIZE[SDTIX] THEN ERROR ErrorReadingFontWidths;
	  IF ReadBlock[s, @index + 1, SIZE[SDTIX] - 1] = 0 THEN
	    ERROR 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 => ERROR ErrorReadingFontWidths;
      ENDLOOP;
    IF ~indexFound THEN ERROR FontNotInFontsDotWidths;
    IF index.x1 # 0 OR index.x2 # 0 THEN ERROR ErrorReadingFontWidths;
    -- position file to starting byte of our info
    StreamDefs.SetPosition[s, InlineDefs.LongMult[index.location, 2]];
    IF ReadBlock[s, @width, SIZE[WidthSegment]] = 0 THEN
      ERROR ErrorReadingFontWidths;
    fBBox _ ScaleThings[width.fBBox];
    fBBoy _ ScaleThings[width.fBBoy];
    fBBdx _ ScaleThings[width.fBBdx];
    fBBdy _ ScaleThings[width.fBBdy];
    IF width.xFeed THEN
      BEGIN
      x _ ScaleThings[s.get[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[s.get[s]]; ENDLOOP;
      END;
    s.destroy[s];
    END;
    
  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.