Program Weave;

{***************************************************************************}

uses

  Croft;



const

  MaxSubs = 50;

  MaxLen = 500;

  Bracket1 = #123;

  Bracket2 = #125;



type

  ScreenType = array[1..MaxLen, 1..80] of char;



var

  WF: text;

  TotalSubs: integer;

  SubName: array[0..MaxSubs] of string;

  SubX: array[0..MaxSubs] of integer;

  SubY: array[0..MaxSubs] of integer;

  TotalX,

  TotalY: integer;

  DF: text;

  Dash: char;

  Slash: char;

  Vertical: char;

  Space: char;

  SaveArray: ScreenType;

  alpha,

  bravo: integer;

  Spread: integer;

  Depth: integer;

  Lead: string;



Function Already(InStr: string): integer;

{***************************************************************************}

var

  bravo: integer;

  TempAlready: integer;

begin

  TempAlready := 0;

  for bravo := 1 to TotalSubs do

    if InStr = SubName[bravo] then

      TempAlready := bravo;

  Already := TempAlready;

end;



Procedure WriteFinal;

{***************************************************************************}

var

  alpha: integer;

  bravo: integer;

  charlie: integer;

  NumSubs: integer;

  SubStr: string;

  SubNum: integer;

  MaxSlash: integer;

  NameStr: string;

  NameNum: integer;

begin

  MaxSlash := 0;

  readln(WF, NameStr);

  NameStr := UpCaseStr(NameStr);

  DropLeadBlanks(NameStr);

  NameNum := Already(NameStr);

  for bravo := 0 to length(NameStr) - 1 do

    SaveArray[SubY[NameNum] + bravo, SubX[NameNum]] :=

      SubName[NameNum, bravo + 1];

  readln(WF, NumSubs);

  if NumSubs <> 0 then

    begin

      for bravo := 1 to NumSubs do

        begin

          readln(WF, SubStr);

          SubStr := UpCaseStr(SubStr);

          DropLeadBlanks(SubStr);

          SubNum := Already(SubStr);

          for charlie := SubX[NameNum] + 1 to SubX[SubNum] - 1 do

            if charlie > MaxSlash then

              SaveArray[SubY[NameNum], charlie] := Dash;

          SaveArray[SubY[NameNum], SubX[SubNum]] := Slash;

          if SubX[SubNum] > MaxSlash then

            MaxSlash := SubX[SubNum];

          for charlie := SubY[NameNum] + 1 to SubY[SubNum] - 1 do

            SaveArray[charlie, SubX[SubNum]] := Vertical;

          for charlie := SubX[NameNum] + 1 to SubX[SubNum] - 1 do

            if charlie > MaxSlash then

              SaveArray[SubY[NameNum], charlie] := Dash;

        end;

    end;

end;



Procedure WriteSubs;

{***************************************************************************}

var

  NameStr: string;

  NameNum: integer;

  SubStr: string;

  SubNum: integer;

  alpha,

  bravo: integer;

  TabStr: string;

  NumSubs: integer;

begin

  readln(WF, NameStr);

  DropLeadBlanks(NameStr);

  NameStr := UpCaseStr(NameStr);

  NameNum := Already(NameStr);

  if NameNum = 0 then

    begin

      if SubName[0] <> '' then

        begin

          Beep;

          writeln('An uncalled procedure has been read!!!');

          PoliteHalt;

        end

      else

        begin

          SubName[0] := NameStr;

          SubX[0] := 1;

          SubY[0] := 1;

          TotalX := 1;

          TotalY := Depth + 2;

        end;

    end;

  readln(WF, NumSubs);

  for alpha := 1 to NumSubs do

    begin

      readln(WF, SubStr);

      DropLeadBlanks(SubStr);

      SubStr := UpCaseStr(SubStr);

      SubNum := Already(SubStr);

      if SubNum = 0 then

        begin

          Inc(TotalSubs);

          SubNum := TotalSubs;

          SubName[SubNum] := SubStr;

          SubX[SubNum] := 0;

          SubY[SubNum] := 0;

        end;

      if SubX[SubNum] = 0 then

        TotalX := TotalX + Spread

      else

        for bravo := 1 to TotalSubs do

          if SubX[bravo] > SubX[SubNum] then

            SubX[bravo] := SubX[bravo] - Spread;

      SubX[SubNum] := TotalX;

      if SubY[SubNum] = 0 then

        begin

          SubY[SubNum] := TotalY;

          TotalY := TotalY + Depth + 1;

        end

      else

        if SubY[SubNum] < SubY[NameNum] then

          begin

            for bravo := 1 to TotalSubs do

              if SubY[bravo] > SubY[SubNum] then

                SubY[bravo] := SubY[bravo] - Depth - 1;

            SubY[SubNum] := TotalY - Depth - 1;

          end;

    end;

end;



Procedure DoWeave;

{***************************************************************************}

var

  alpha: integer;

  EndStr: string;

begin

  TotalSubs := 0;

  Reset(WF);

  SubName[0] := '';

  repeat

    WriteSubs;

  until EOF(WF);

  close(WF);

  reset(WF);

  repeat

    WriteFinal;

  until EOF(WF);

  Close(WF);

  Rewrite(DF);

  if Lead <> '' then

    writeln(DF, Bracket1, MultiChar('*',75), Bracket2);

  for alpha := 1 to TotalY do

    writeln(DF, Lead, SaveArray[alpha]);

  repeat

    Inc(Alpha);

    EndStr := SaveArray[alpha];

    writeln(DF, Lead, EndStr);

    DropLeadBlanks(EndStr);

  until EndStr = '';

  if Lead <> '' then

    writeln(DF, Bracket1, MultiChar('*',75), Bracket2);

  close(DF);

end;



Procedure GetSpread;

{***************************************************************************}

var

  NulPresent: boolean;

begin

  Clr;

  Say('The Spread is how separated the names will be spread out.');

  Say('A Spread of 2 will allow up to 40 names on a page.');

  Say('A Spread of 3 would limit the names to (80/3) = 26.');

  Say('The minimum Spread is 1.  The maximum Spread is 80.');

  AskPosNul('What Spread do you want? [Default = 2]',

    80, Spread, NulPresent);

  if NulPresent then

    Spread := 2;

  writeln;

  Say('The Depth is how separated the names will be vertically.');

  Say('A Depth of 2 will allow approximately 250 names in a file.');

  Say('A Depth of 3 would limit the names to (500/3) = 166.');

  Say('The minimum Depth is 1.  The maximum Depth is 500.');

  AskPosNul('What Depth do you want? [Default = 2]',

    500, Depth, NulPresent);

  if NulPresent then

    Depth := 2;

  writeln;

  Say(

    'A lead of "'+Bracket1+'* " can be added to the beginning of each line.');

  Say('This is useful to designate the WEAVE lines in a document.');

  if AskYN('Do you want the lead?', 'Y') then

    Lead := Bracket1 + '* '

  else

    Lead := '';

end;



Procedure SetUpFiles;

{***************************************************************************}

var

  Lead8: string;

  InFile,

  OutFile: string;

begin

  Clr;

  InFile := GetDirFileOnly('*.WEV');

  SplitFileName(InFile, Lead8, DumStr);

  OutFile := Lead8 + '.OUT';

  writeln;

  Say('InFile :  '+InFile);

  Say('OutFile:  '+OutFile);

  Wait;

  Assign(WF, InFile);

  Assign(DF, OutFile);

end;



Procedure IntroScrn;

{***************************************************************************}

begin

  Clr;

  Say('WEAVE by 2Lt David Croft, 31st TES');

  writeln;

  Say('     This program takes a file describing a non-hierarchial');

  Say('interdependency and maps it out in a visual format to another file.');

  Say('This program is useful for documenting cross-referenced items or');

  Say('source code sub-program calls.  The input file must have the extension');

  Say('".WEV".  The output file will have the extension ".OUT".  The size');

  Say('is limited to 40 intertwined items of name-length less than 10');

  Say('characters on average.');

  Wait;

  Clr;

  Say('The input file must be a text file of this format:');

  Say('The name of the main/root/beginning from which all spring from');

  Say('Its number of sub-headings');

  Say('The names of the sub-headings');

  Say('A previously mentioned sub-heading name');

  Say('It number of sub-sub-headings');

  Say('The names of the sub-sub-headings');

  Say('etc.');

  Say('Example:');

  Say('MAIN');

  Say('  2');

  Say('  Procedure 1');

  Say('  Function 2');

  Say('Procedure 1');

  Say('  2');

  Say('  Function 2');

  Say('  Function 3');

  Say('Function 2');

  Say('  1');

  Say('  Function 3');

  Say('Function 3');

  Say('  0');

  Wait;

end;



{***************************************************************************}

{***************************************************************************}

begin

  for alpha := 1 to MaxLen do

    for bravo := 1 to 80 do

      SaveArray[alpha,bravo] := ' ';

  Dash := '-';

  Slash := '\';

  Vertical := '|';

  Space := '.';

  IntroScrn;

  SetUpFiles;

  GetSpread;

  DoWeave;

  Say('Program complete.');

  Wait;

end.