Program Ch;



uses

  Crt,

  Dos;



const

  Up = #72;

  Down = #80;



var

  DirInfo: SearchRec;

  NumDirs: integer;

  Dir: array[1..24] of string[12];

  alpha: integer;

  NewDir: integer;

  DirStr: string;

  DumInt: integer;

  InChar: char;

  ArrowChar: char;

  Bottom: integer;

  DumWord,

  Sec100: word;



Procedure WriteDirs(StartY: integer);

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

begin

  GotoXY(1, StartY);

  for alpha := 1 to NumDirs do

    begin

      if alpha = NewDir then

        HighVideo

      else

        LowVideo;

      ClrEol;

      writeln(Dir[alpha]);

    end;

end;



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

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

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

begin

  LowVideo;

  if WhereX <> 1 then

    writeln;

  write('"Ch" by ');

  GetTime(DumWord, DumWord, DumWord, Sec100);

  if Odd(Sec100) then

    write('Deadliner Cognomen')

  else

    write('David W. Croft');

  write('.  FreeWare.  ');

  writeln('Use ',#24,', ',#25,', SPACE, ENTER, and ESC.');

repeat

  NumDirs := 0;

  FindFirst('*.*',Directory,DirInfo);

  while DosError = 0 do

    begin

      if (DirInfo.Attr = 16) and (DirInfo.Name <> '.') then

        begin

          Inc(NumDirs);

          if NumDirs = 25 then

            begin

              writeln('Too many directories for "Ch".');

              halt;

            end;

          Dir[NumDirs] := DirInfo.Name;

        end;

      FindNext(DirInfo);

    end;

  if NumDirs = 0 then

    begin

      writeln('No directories found.');

      halt;

    end;

  NewDir := 1;

  WriteDirs(WhereY);

  Bottom := WhereY;

  repeat

    repeat

    until Keypressed;

    InChar := readkey;

    if InChar = #27 then

      halt;

    if InChar = #0 then

      begin

        ArrowChar := readkey;

        if ArrowChar = Up then

          Dec(NewDir)

        else

          if ArrowChar = Down then

            Inc(NewDir);

        if NewDir = 0 then

          NewDir := NumDirs;

        if NewDir = NumDirs + 1 then

          NewDir := 1;

        WriteDirs(Bottom - NumDirs);

      end;

  until (InChar = #13) or (InChar = ' ');

  LowVideo;

  writeln('Directory changed to "',Dir[NewDir],'".');

  ChDir(Dir[NewDir]);

until InChar = #13;

NormVideo;

end.