uses

  Crt;



const

  Forever = false;

  MaxLen = 15;



var

  Num: string[MaxLen];

  alpha: integer;

  Poss: array[1..MaxLen, 1..3] of char;

  Digital,

  StopNum: array[1..MaxLen] of char;

  Done: boolean;

  TempVal,

  DumInt: integer;

  LenNum: byte;

  Match: boolean;

  PossOK: array[1..MaxLen] of boolean;

  NameStr: string;

  option: char;

  OutF: boolean;

  DF: text;

  OutOpt: char;



procedure Wr2T(InStr: string);

begin

  write(InStr);

  if OutF then

    write(DF, InStr);

end;



procedure Wr2TLn(InStr: string);

begin

  writeln(InStr);

  if OutF then

    writeln(DF, InStr);

end;



function Trans(InChar: char): char;

var

  T: char;

begin

  InChar := upcase(InChar);

  case InChar of

    'A': T := '2';

    'B': T := '2';

    'C': T := '2';

    'D': T := '3';

    'E': T := '3';

    'F': T := '3';

    'G': T := '4';

    'H': T := '4';

    'I': T := '4';

    'J': T := '5';

    'K': T := '5';

    'L': T := '5';

    'M': T := '6';

    'N': T := '6';

    'O': T := '6';

    'P': T := '7';

    'Q': T := ' ';

    'R': T := '7';

    'S': T := '7';

    'T': T := '8';

    'U': T := '8';

    'V': T := '8';

    'W': T := '9';

    'X': T := '9';

    'Y': T := '9';

    'Z': T := ' ';

    else

      T := InChar;

  end; {case}

  Trans := T;

end;



procedure GetNum;

begin

  repeat

    Write('Name (ENTER to quit):  ');

    readln(NameStr);

    if NameStr <> '' then

      begin

        Wr2T(NameStr+' = ');

        for alpha := 1 to length(NameStr) do

          Wr2T(Trans(NameStr[alpha]));

        Wr2TLn('');

      end;

  until NameStr = '';

end;



begin

  clrscr;

  Write('Do you want the output to go to a file? (y/N):  ');

  readln(OutOpt);

  OutOpt := upcase(OutOpt);

  OutF := false;

  if OutOpt = 'Y' then

    begin

      Writeln('Output is going to "FONEWORD.SAV".');

      OutF := true;

      Assign(DF, 'FoneWord.Sav');

      Rewrite(DF);

    end;

  repeat

    repeat

      Writeln;

      Writeln('1) Number to Name ("8378464" to "TESTING"');

      Writeln('2) Name to Number ("TESTING" to "8378464")');

      writeln('3) Quit');

      Write('Option:  ');

      readln(option);

      if option = '3' then

        begin

          if OutF then

            close(DF);

          halt;

        end;

      if option = '2' then

        GetNum;

    until option = '1';

  repeat

    Write('Number:  ');

    readln(Num);

    Wr2T(Num + ' = ');

    LenNum := length(Num);

    if LenNum <= 1 then

      Write(#7);

  until LenNum > 1;

  for alpha := 1 to LenNum do

    begin

      PossOK[alpha] := true;

      case Num[alpha] of

        '1': begin

               PossOK[alpha] := false;

               Poss[alpha, 1] := '1';

               Poss[alpha, 2] := '1';

               Poss[alpha, 3] := '1';

             end;

        '2': begin

               Poss[alpha, 1] := 'A';

               Poss[alpha, 2] := 'B';

               Poss[alpha, 3] := 'C';

             end;

        '3': begin

               Poss[alpha, 1] := 'D';

               Poss[alpha, 2] := 'E';

               Poss[alpha, 3] := 'F';

             end;

        '4': begin

               Poss[alpha, 1] := 'G';

               Poss[alpha, 2] := 'H';

               Poss[alpha, 3] := 'I';

             end;

        '5': begin

               Poss[alpha, 1] := 'J';

               Poss[alpha, 2] := 'K';

               Poss[alpha, 3] := 'L';

             end;

        '6': begin

               Poss[alpha, 1] := 'M';

               Poss[alpha, 2] := 'N';

               Poss[alpha, 3] := 'O';

             end;

        '7': begin

               Poss[alpha, 1] := 'P';

               Poss[alpha, 2] := 'R';

               Poss[alpha, 3] := 'S';

             end;

        '8': begin

               Poss[alpha, 1] := 'T';

               Poss[alpha, 2] := 'U';

               Poss[alpha, 3] := 'V';

             end;

        '9': begin

               Poss[alpha, 1] := 'W';

               Poss[alpha, 2] := 'X';

               Poss[alpha, 3] := 'Y';

             end;

        '0': begin

               PossOK[alpha] := false;

               Poss[alpha, 1] := '0';

               Poss[alpha, 2] := '0';

               Poss[alpha, 3] := '0';

             end;

        else

           begin

             PossOK[alpha] := false;

             Poss[alpha, 1] := Num[alpha];

             Poss[alpha, 2] := Num[alpha];

             Poss[alpha, 3] := Num[alpha];

           end;

      end; {case}

    end;

  for alpha := 1 to LenNum do

    Digital[alpha] := '1';

  StopNum[1] := '4';

  for alpha := 2 to LenNum do

    StopNum[alpha] := '1';

  Match := false;

  repeat

    repeat

      Done := true;

      for alpha := 1 to LenNum do

        if (Digital[alpha] = '4') or

          (not(PossOk[alpha]) and not(Digital[alpha] = '1')) then

          begin

            Done := false;

            Digital[alpha] := '1';

            if (alpha - 1) = 0 then

              begin

                Done := true;

                Match := true;

                alpha := LenNum;

              end

            else

              Digital[alpha - 1] := chr(ord(Digital[alpha-1])+1);

            if not(Done) then

              for alpha := 1 to LenNum do

                if Digital[alpha] <> StopNum[alpha] then

                  Match := false;

            if Match then

              Done := true;

          end;

    until Done;

    if not(Match) then

      begin

        if WhereX + LenNum + 1 > 80 then

          Wr2Tln('');

        if WhereY = 25 then

          begin

            readln;

            clrscr;

          end;

        for alpha := 1 to LenNum do

          begin

            val(Digital[alpha], TempVal, DumInt);

            Wr2T(Poss[alpha, TempVal]);

          end;

        Wr2T(' ');

        Digital[LenNum] := chr(ord(Digital[LenNum])+1);

      end;

  until Match;

  readln;

  until Forever;

end.