Program P7(Output, Infile, Outfile);

{
  Insertion Sort
}

Const
  LISTSIZE = 100;
  NAMESIZE = 20;

Type
  NameType = Array[1..NAMESIZE] Of Char;
  ListType = Array [1..LISTSIZE] of NameType;

Var
  List:ListType;

  Name:NameType;

  NameCt:Integer;

  Outfile,
  Infile:Text;

Procedure ReadName(Var Name:NameType);
  Var
    I:Integer;
    Ch:Char;
  Begin {ReadName}
    I := 1;
    While Not Eoln(Infile) Do
      Begin
        Read(Infile, Ch);
        If I <= NAMESIZE
          Then
            Begin
              Name[I] := Ch;
              I := I + 1;
            End;
      End;
    Readln(Infile);
    For I := I To NAMESIZE Do
      Name[I] := ' ';
  End; {ReadName}

Function findwhere(Var List:ListType;
                       Name:NameType;
                       NameCt:Integer):Integer;
  Var
    i:Integer;

  Function GE(Name1, Name2:NameType):Boolean;
    Var
      I:Integer;

    Begin {GE}
      I := 1;
      While (I < NAMESIZE) And (Name1[I] = Name2[I]) Do
        I := I + 1;
      GE := Name1[I] >= Name2[I];
    End; {GE}

  Begin {findwhere}
    i := 1;
    while (i <= Namect) AND GE(Name, list[i]) Do
      i := i + 1;
    findwhere := i;
  End; {findwhere}

procedure makeroom(Var List:ListType;
                       Namect, i:Integer);
  Var
    j:Integer;

  Begin {makeroom}
    j := Namect;
    while j >= i Do
      Begin
        list[j+1] := list[j];
        j := j - 1;
      End;
  End; {makeroom}

Procedure insertNameInList(Var List:ListType;
                               Name:NameType;
                               NameCt:Integer);

  Var
    i:integer;

  Begin {InsertNameInList}
    i := findwhere(List, Name, NameCt);
    makeroom(List, NameCt, i);
    list[i] := Name;
  End; {InsertNameInList}

Procedure PrintName(Name:NameType);
  Var
    I:Integer;

  Begin {PrintName}
    For I := 1 to NAMESIZE Do
      Write(Outfile, Name[I]);
  End; {PrintName}

Procedure printlist(List:ListType;
                    NameCt:Integer);

  Var
    i:integer;

  Begin {PrintList}
    i := 1;
    while i <= Namect Do
      Begin
        PrintName(list[i]);
        Writeln(Outfile);
        i := i + 1;
      End;
  End; {PrintList}

  Begin {P7}
    Assign(Infile, 'c:\Namesort.txt');
    Reset(Infile);
    Assign(Outfile, 'c:\NSortOut.txt');
    Rewrite(outfile);
    Namect := 0;
    Writeln(Outfile, 'Before sort');
    while not eof(Infile) Do
      Begin
        ReadName(Name);
        PrintName(Name);
        Writeln(Outfile);
        insertNameInList(List, Name, NameCt);
        Namect := Namect + 1;
      End;

    Writeln(outfile);
    Writeln(Outfile, 'After sort');
    printlist(List, NameCt);

    Close(Outfile);
  End. {P7}