-- 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.