-- PressFontWidths.mesa, edit by Johnsson; 16-Mar-81 18:14:37

DIRECTORY
  Inline USING [LongDiv, LongMult],
  Press USING [
    BadParameters, FontSlope, FontWeight, magicNonPrintingWidth, Mica,
    micasPerInch, Points, pointsPerInch],
  PressUtilities USING [],
  Streams USING [Destroy, GetWord, NewStream, GetBlock, SetIndex, Handle];

PressFontWidths: PROGRAM
  IMPORTS Inline, Press, Streams 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: LONG STRING, points: Points, weight: FontWeight, slope: FontSlope,
    widths: LONG POINTER TO ARRAY CHARACTER OF Mica]
    RETURNS [fBBox, fBBoy, fBBdx, fBBdy: Mica] =
    BEGIN OPEN Streams;
    
    ScaleThings: PROCEDURE [p: CARDINAL] RETURNS [m: Mica] =
      BEGIN OPEN Inline;
      m ← LOOPHOLE[p, Mica];
      IF m = Press.magicNonPrintingWidth THEN RETURN;
      IF index.size # 0 THEN RETURN;
      -- 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: Streams.Handle ← NewStream["Fonts.widths"L];
    e: IX;
    header: IXN;
    index: SDTIX;
    width: WidthSegment;
    x: WORD;
    BEGIN ENABLE UNWIND => Streams.Destroy[s];
    pointSizeInMicas ← Inline.LongDiv[
      Inline.LongMult[Press.micasPerInch, points], Press.pointsPerInch];
    -- copy over the family name into Fonts.Widths format
    IF family.length NOT IN (0..19] THEN ERROR Press.BadParameters;
    name ← ALL[0];
    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 GetBlock[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 GetBlock[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 GetBlock[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
    Streams.SetIndex[s, Inline.LongMult[index.location, 2]];
    IF GetBlock[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[Streams.GetWord[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[Streams.GetWord[s]]; ENDLOOP;
      END;
    END; -- of ENABLE
    Streams.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.