-- AlFont.mesa Edited by: Sandman on July 1, 1980  10:04 AM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  BitBltDefs USING [AlignedBBTable, BBptr, BBTableSpace, BITBLT],
  FontDefs USING [BitmapState, FontHandle, FontObject],
  InlineDefs USING [BITAND, BITOR, BITSHIFT],
  SegmentDefs USING [
    FileSegmentAddress, FileSegmentHandle, SwapIn, SwapOut, Unlock],
  Storage USING [Node, Free];

AlFont: PROGRAM
  IMPORTS BitBltDefs, InlineDefs, SegmentDefs, Storage EXPORTS FontDefs =
  BEGIN OPEN FontDefs;

  FileSegmentHandle: TYPE = SegmentDefs.FileSegmentHandle;

  CR: CHARACTER = 15C;
  SP: CHARACTER = ' ;

  AlFontObject: TYPE = RECORD [
    procs: FontObject,
    seg: FileSegmentHandle,
    lockCount: CARDINAL,
    height: CARDINAL];

  AlFontHandle: TYPE = POINTER TO AlFontObject;

  FHptr: TYPE = POINTER TO FontHeader;
  Fptr: TYPE = POINTER TO Font;
  FCDptr: TYPE = POINTER TO FCD;
  FAptr: TYPE = POINTER TO FontArray;
  FontArray: TYPE = ARRAY [0..255] OF FCDptr;

  Font: TYPE = MACHINE DEPENDENT RECORD [
    header: FontHeader,
    FCDptrs: FontArray, -- array of self-relative pointers to
    -- FCD's. Indexed by char value.
    -- font pointer points hear!
    extFCDptrs: FontArray -- array of self-relative pointers to
    -- FCD's for extentions. As large an
    -- array as needed.
    ];

  FontHeader: TYPE = MACHINE DEPENDENT RECORD [
    maxHeight: CARDINAL, -- height of tallest char in font (scan lines)
    variableWidth: BOOLEAN, -- IF TRUE, proportionally spaced font
    blank: [0..177B], -- not used
    maxWidth: [0..377B] -- width of widest char in font (raster units).
    ];

  FCD: TYPE = MACHINE DEPENDENT RECORD [
    widthORext: [0..77777B], -- width or extention index
    hasNoExtension: BOOLEAN, -- TRUE=> no ext.;prevfield=width
    height: [0..377B], -- # scan lines to skip for char
    displacement: [0..377B] -- displacement back to char bitmap
    ];

  CharWidth: PUBLIC PROCEDURE [font: FontHandle, char: CHARACTER]
    RETURNS [w: CARDINAL] =
    BEGIN
    code: CARDINAL;
    cw: FCDptr;
    fontdesc: FAptr; -- checkfor control characters
    IF char = CR THEN char _ SP;
    IF char < SP THEN RETURN[CharWidth[font, '^] + CharWidth[font, char + 100B]];
    w _ 0;
    fontdesc _ @LockFont[font].FCDptrs;
    code _ LOOPHOLE[char];
    DO
      cw _ LOOPHOLE[fontdesc[code] + LOOPHOLE[fontdesc, CARDINAL] + code];
      IF cw.hasNoExtension THEN EXIT;
      w _ w + 16;
      code _ cw.widthORext;
      ENDLOOP;
    w _ w + cw.widthORext;
    UnlockFont[font];
    RETURN
    END;

  CharHeight: PUBLIC PROCEDURE [font: FontHandle, char: CHARACTER]
    RETURNS [CARDINAL] = BEGIN RETURN[LOOPHOLE[font, AlFontHandle].height] END;

  PaintChar: PROCEDURE [
    font: FontHandle, char: CHARACTER, bmState: POINTER TO BitmapState] =
    BEGIN OPEN BitBltDefs, bmState;
    bba: BBTableSpace;
    bbt: BBptr = AlignedBBTable[@bba];
    cw: FCDptr;
    fontdesc: FAptr = @LockFont[font].FCDptrs;
    code: CARDINAL _ LOOPHOLE[char];
    bbt^ _
      [sourcetype: block, function: paint, dbca: origin, dbmr: wordsPerLine,
	dlx: x, dw: 16, sbmr: 1, slx: 0, sty: 0];
    DO
      cw _ LOOPHOLE[fontdesc[code] + LOOPHOLE[fontdesc, CARDINAL] + code];
      bbt.dty _ y + cw.height;
      bbt.dh _ cw.displacement;
      bbt.sbca _ cw - (bbt.dh _ cw.displacement);
      IF cw.hasNoExtension THEN
	BEGIN x _ x + (bbt.dw _ cw.widthORext); BITBLT[bbt]; EXIT END
      ELSE BEGIN BITBLT[bbt]; bbt.dlx _ x _ x + 16; END;
      code _ cw.widthORext;
      ENDLOOP;
    UnlockFont[font];
    RETURN
    END;

  ClearChar: PROCEDURE [
    font: FontHandle, char: CHARACTER, bmState: POINTER TO BitmapState] =
    BEGIN OPEN bmState, InlineDefs;
    bit: [0..15];
    xword: CARDINAL;
    scanLines: CARDINAL = LOOPHOLE[font, AlFontHandle].height;
    start, p: POINTER;
    cwidth: INTEGER _ CharWidth[font, char];
    mask: WORD;
    ones: WORD = 177777B;
    IF x < cwidth THEN BEGIN cwidth _ x; x _ 0 END ELSE x _ x - cwidth;
    xword _ x/16;
    bit _ x MOD 16;
    mask _ BITOR[BITSHIFT[ones, 16 - bit], BITSHIFT[ones, -(bit + cwidth)]];
    start _ origin + xword + y*wordsPerLine - 1;
    cwidth _ cwidth + bit;
    DO
      p _ start _ start + 1;
      THROUGH [0..scanLines) DO
	p^ _ BITAND[p^, mask]; p _ p + wordsPerLine; ENDLOOP;
      IF (cwidth _ cwidth - 16) <= 0 THEN EXIT;
      mask _ BITSHIFT[ones, -cwidth];
      ENDLOOP;
    RETURN
    END;

  LockFont: PROCEDURE [font: FontHandle] RETURNS [Fptr] =
    BEGIN OPEN SegmentDefs, af: LOOPHOLE[font, AlFontHandle];
    IF (af.lockCount _ af.lockCount + 1) = 1 THEN SwapIn[af.seg];
    RETURN[FileSegmentAddress[af.seg]]
    END;

  UnlockFont: PROCEDURE [font: FontHandle] =
    BEGIN OPEN SegmentDefs, af: LOOPHOLE[font, AlFontHandle];
    IF (af.lockCount _ af.lockCount - 1) = 0 THEN
      BEGIN Unlock[af.seg]; af.seg.inuse _ TRUE END;
    RETURN
    END;

  DestroyFont: PROCEDURE [font: FontHandle] =
    BEGIN CloseFont[font]; Storage.Free[font]; RETURN END;

  CloseFont: PROCEDURE [font: FontHandle] =
    BEGIN OPEN af: LOOPHOLE[font, AlFontHandle];
    IF af.seg.lock = 0 THEN SegmentDefs.SwapOut[af.seg];
    RETURN
    END;

  CreateFont: PUBLIC PROCEDURE [fontSegment: FileSegmentHandle]
    RETURNS [f: FontHandle] =
    BEGIN
    p: AlFontHandle = Storage.Node[SIZE[AlFontObject]];
    f _ LOOPHOLE[p];
    p^ _
      [procs:
       [paintChar: PaintChar, clearChar: ClearChar, charWidth: CharWidth,
	 charHeight: CharHeight, close: CloseFont, destroy: DestroyFont,
	 lock: LockFont, unlock: UnlockFont], seg: fontSegment, lockCount: 0,
	height: 0];
    p.height _ LockFont[f].header.maxHeight;
    UnlockFont[f];
    RETURN
    END;


  END..........