-- ALEMerge.mesa
--   Edited by Sweet, August 19, 1980  1:08 PM
DIRECTORY
  ALEOps,
  AltoDefs,
  SegmentDefs,
  String,
  Table;

ALEMerge: PROGRAM
  IMPORTS ALEOps, SegmentDefs
  EXPORTS ALEOps =
  BEGIN OPEN ALEOps;

  ptb, ltb, lbb: Table.Base;
  htb: Table.Base;
  ssb: STRING;
  ht: DESCRIPTOR FOR ARRAY HTIndex OF HTRecord;

  HVLength: PRIVATE CARDINAL = 71;
  HVIndex: TYPE = CARDINAL [0..HVLength);

  HTRecord: TYPE = RECORD [
    anyInternal, anyPublic: BOOLEAN,
    link: HTIndex,
    ssIndex: CARDINAL];

  HTIndex: TYPE = CARDINAL [0..Table.Limit/2);
  HTNull: HTIndex = FIRST[HTIndex];

  -- points, lines, etc.

  Label: TYPE = RECORD [
    free: BOOLEAN ← FALSE,
    selected: BOOLEAN ← TRUE,
    font: FontSize ← small,
    hti: HTIndex,
    pos: APosition];
  LBIndex: TYPE = Table.Base RELATIVE POINTER [0..Table.Limit) TO Label;
  LBHandle: TYPE = POINTER TO Label;
  LBNull: LBIndex = LAST[LBIndex];

  ALEHeader: TYPE = RECORD [
    htTableSize: CARDINAL,
    ssTableSize: CARDINAL,
    pointTableSize: CARDINAL,
    lineTableSize: CARDINAL,
    labelTableSize: CARDINAL,
    freePoint: PTIndex,
    freeLine: LTIndex,
    freeLabel: LBIndex];

  Point: TYPE = RECORD [
    free, selected: BOOLEAN ← FALSE,
    lines: LTIndex ← LTNull,
    pos: APosition];
  PTIndex: TYPE = Table.Base RELATIVE POINTER [0..Table.Limit) TO Point;
  PTHandle: TYPE = POINTER TO Point;
  PTNull: PTIndex = LAST[PTIndex];

  Line: TYPE = RECORD [
    free: BOOLEAN ← FALSE,
    selected: BOOLEAN ← TRUE,
    p1: PTIndex,
    width: LineWidth,
    p2: PTIndex,
    repainted: BOOLEAN ← FALSE,
    texture: LineTexture,
    p1Chain: LTIndex,
    class: LineClass,
    p2Chain: LTIndex];
  LTIndex: TYPE = Table.Base RELATIVE POINTER [0..Table.Limit) TO Line;
  LTHandle: TYPE = POINTER TO Line;
  LTNull: LTIndex = LAST[LTIndex];

  PointScan: TYPE = PROCEDURE [p: PTIndex, pth: PTHandle] RETURNS [stop: BOOLEAN];
  LineScan: TYPE = PROCEDURE [l: LTIndex, lth: LTHandle] RETURNS [stop: BOOLEAN];
  LabelScan: TYPE = PROCEDURE [lb: LBIndex, lbh: LBHandle] RETURNS [stop: BOOLEAN];

  AllMyLines: PROC [action: LineScan] RETURNS [l: LTIndex] =
    BEGIN
    FOR l ← FIRST[LTIndex], l + SIZE[Line] WHILE
	 LOOPHOLE[l, CARDINAL] < header.lineTableSize DO
      IF ~ltb[l].free AND action[l, @ltb[l]] THEN RETURN;
      ENDLOOP;
    RETURN[LTNull]
    END;

  AllMyLabels: PROC [action: LabelScan] RETURNS [lb: LBIndex] =
    BEGIN
    FOR lb ← FIRST[LBIndex], lb + SIZE[Label] WHILE 
	LOOPHOLE[lb, CARDINAL] < header.labelTableSize DO
      IF ~lbb[lb].free AND action[lb, @lbb[lb]] THEN RETURN;
      ENDLOOP;
    RETURN[LBNull]
    END;

  header: POINTER TO ALEHeader;

  MergeInFile: PUBLIC PROC [file: STRING] =
    BEGIN OPEN SegmentDefs;
    fh: FileHandle = NewFile[file, Read! FileNameError => GO TO cant];
    seg: FileSegmentHandle = 
	NewFileSegment[fh, DefaultBase, DefaultPages, Read];

    AddThisLine: LineScan =
      BEGIN
      pos1: APosition = ptb[lth.p1].pos;
      pos2: APosition = ptb[lth.p2].pos;
      currentWidth ← lth.width;
      currentTexture ← lth.texture;
      DrawLine[pos1, pos2, FALSE];
      RETURN[FALSE];
      END;

    AddThisLabel: LabelScan =
      BEGIN
      desc: String.SubStringDescriptor;
      pos: APosition = lbh.pos;
      currentFont ← lbh.font;
      SubStringForHash[@desc, lbh.hti];
      SSDrawLabel[@desc, pos];
      RETURN[FALSE];
      END;

    SwapIn[seg];
    header ← FileSegmentAddress[seg];
    htb ← LOOPHOLE[header + SIZE[ALEHeader] + LAST[HVIndex] + 1];
    ht ← DESCRIPTOR[htb, header.htTableSize/SIZE[HTRecord]];
    ssb ← LOOPHOLE[htb + header.htTableSize + 1];
    ptb ← LOOPHOLE[ssb + header.ssTableSize];
    ltb ← LOOPHOLE[ptb + header.pointTableSize];
    lbb ← LOOPHOLE[ltb + header.lineTableSize];
    [] ← AllMyLines[AddThisLine];
    [] ← AllMyLabels[AddThisLabel];
    Unlock[seg];
    DeleteFileSegment[seg];
    ClearText[];
    EXITS
      cant => OutString[" not found"L];
    END;

  SubString: TYPE = String.SubString;
  CharsPerWord: PRIVATE CARDINAL = AltoDefs.CharsPerWord;

  SubStringForHash: PROC [s: SubString, hti: HTIndex] = {
    s.base ← ssb;
    IF hti = HTNull
      THEN s.offset ← s.length ← 0
      ELSE s.length ← ht[hti].ssIndex - (s.offset ← ht[hti-1].ssIndex)};

  END.