{$M 32767,0,655360}
PROGRAM Concordination (Input, Output, FileName);
{Purpose: This program is supposed to read in a file and then write
out every word and the line it is found on to another text file.
Written in Turbo Pascal v6.0}
USES CRT;

TYPE
    List =^LineList;
    LineList = RECORD
             Line : INTEGER;
             Next : List;
    END;{LineList}
    Tree =^TreeRecord;
    TreeRecord = RECORD
               Word : STRING;
               Line : List;
               Left : Tree;
               Right : Tree;
    END;{TreeRecord}

VAR
   Head : Tree;
   FileName : TEXT;

PROCEDURE Erase(VAR WordName : STRING);
VAR
   X : INTEGER;
BEGIN
     FOR X:=1 TO 255 DO WordName[X]:=CHR(32);
     FOR X:=1 TO 255 DO WordName:=WordName+' ';
END;{Erase}

PROCEDURE Initialize;
BEGIN
     Head:=NIL;
END;{Initialize}

PROCEDURE First(WordName : STRING; Line : INTEGER);
BEGIN
     NEW(Head);
     Head^.Word:=WordName;
     NEW(Head^.Line);
     Head^.Line^.Line:=Line;
     Head^.Line^.Next:=NIL;
     Head^.Left:=NIL;
     Head^.Right:=NIL;
END;{First}

PROCEDURE AddLine(Line : INTEGER; Head : List);
VAR
   Temp : List;
BEGIN
     NEW(Temp);
     Temp^.Next:=NIL;
     Temp^.Line:=Line;
     WHILE Head^.Next<>NIL DO BEGIN
           Head:=Head^.Next;
     END;{Head^.Next<>NIL}
     Head^.Next:=Temp;
     Temp:=NIL;
END;{AddLine}

PROCEDURE AddRec(WordName : STRING; Line : INTEGER;VAR Head : Tree);
VAR
   Temp : Tree;
BEGIN
     WRITE(Output,'.');
     NEW(Temp);
     Temp^.Right:=NIL;
     Temp^.Left:=NIL;
     Temp^.Word:=WordName;
     NEW(Temp^.Line);
     Temp^.Line^.Next:=NIL;
     Temp^.Line^.Line:=Line;
     IF Head^.Word>WordName THEN Head^.Left:=Temp ELSE Head^.Right:=Temp;
     Temp:=NIL;
END;{AddRec}

PROCEDURE Add(WordName : STRING; Line : INTEGER; Head : Tree);
BEGIN
     If Head<>NIL THEN BEGIN
        IF Head^.Word=WordName THEN AddLine(Line,Head^.Line) ELSE BEGIN
           IF Head^.Word>WordName THEN
              IF Head^.Left=NIL THEN AddRec(WordName,Line,Head) ELSE Add(WordName,Line,Head^.Left);
           IF Head^.Word<WordName THEN
              IF Head^.Right=NIL THEN AddRec(WordName,Line,Head) ELSe Add(WordName,Line,Head^.Right);
        END;{Head^.Word=Word}
     END;
END;{Add}

PROCEDURE WriteFile(Head : Tree);
VAR
   Temp : List;
BEGIN
     IF Head<>NIL THEN BEGIN
        WriteFile(Head^.Left);
        WRITE(FileName,Head^.Word);
        Temp:=Head^.Line;
        REPEAT
              WRITE(FileName,Temp^.Line,' ');
              Temp:=Temp^.Next;
        UNTIL Temp=NIL;
        WRITELN(FileName);
        WriteFile(Head^.Right);
     END;{Head<>NIL}
END;{WriteFile}

PROCEDURE Test(VAR WordStr : STRING; Line : INTEGER);
BEGIN
                     IF WordStr[1]<>CHR(32) THEN
                     IF HEAD=NIL THEN First(WordStr,Line) ELSE Add(WordStr,Line,Head);
                     ERASE(WordStr);
END;{Test}

PROCEDURE ReadFile;
VAR
   Line : INTEGER;
   Temp : CHAR;
   WordStr : STRING;
   Number : INTEGER;
BEGIN
     Line:=1;
     WHILE NOT EOF(FileName) DO BEGIN
           Erase(WordStr);
           Number:=1;
           WHILE NOT EOLN(FileName) DO BEGIN
                 READ(FileName,Temp);
                 Temp:=UPCASE(Temp);
                 IF Temp IN ['A'..'Z'] THEN BEGIN
                    WordStr[Number]:=Temp;
                    Number:=Number+1;
                 END ELSE BEGIN
                     Test(WordStr,Line);
                     Number:=1;
                 END;{Temp IN ['A'..'Z']}
           END;{EOLN(FileName)}
           Test(WordStr,Line);
           READLN(FileName);
           Line:=Line+1;
     END;{EOF(FileName)}
END;{ReadFile}

PROCEDURE InError(InName : STRING);
BEGIN
     WRITELN(Output,'Could not open file: ',InName);
     HALT(1);
END;{InError}

PROCEDURE OutError(OutName : STRING);
BEGIN
     WRITELN(Output,'Could not create file: ',OutName);
     HALT(2);
END;{OutError}

PROCEDURE MainLoop;
VAR
   InName : STRING;
   OutName : STRING;
BEGIN
     Initialize;
     CLRSCR;
     Erase(InName);
     Erase(OutName);
     WRITELN(Output,'What is the name of the file to concordinate?');
     READLN(Input,InName);
     WRITELN(Output,'What is the name of the file to receive the concordination?');
     READLN(Input,OutName);
     {$I-}
     ASSIGN(FileName,InName);
     RESET(FileName);
     {$I+}
     IF IOResult<>0 THEN InError(InName);
     ReadFile;
     CLOSE(FileName);
     {$I-}
     ASSIGN(FileName,OutName);
     REWRITE(FileName);
     {$I+}
     IF IOResult<>0 THEN OutError(OutName);
     WriteFile(Head);
     CLOSE(FileName);
END;{MainLoop}

BEGIN
     MainLoop;
END.