Program Ch;



uses

  Crt,

  Data,

  Dos,

  Glob,

  Scrn;



const

  MaxNumDirs = 24*5;

  Lines = MaxNumDirs div 5;



var

  DirInfo: SearchRec;

  NumDirs: integer;

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

  NewDir:  integer;

  DirStr: string;

  DumInt: integer;

  InChar: char;

  ArrowChar: char;

  Bottom: integer;

  DumWord,

  Sec100: word;

  NewDirStr: string;



Procedure LoadDirs;

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

begin

  NumDirs := 0;

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

  while DosError = 0 do

    begin

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

        begin

          Inc(NumDirs);

          if NumDirs > MaxNumDirs 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;

end;



Procedure WriteDirs(StartY: integer);

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

var

  alpha: integer;

  TheDir: string;

begin

  GotoXY(1, StartY);

  ClrEol;

  for alpha := 1 to NumDirs do

    begin

      TheDir := Dir[alpha];

      if alpha = NewDir then

        TheDir := ArrowRight + TheDir + ArrowLeft

      else

        TheDir := ' ' + TheDir + ' ';

      TheDir := StrSized(TheDir, 15);

      write(TheDir);

      if (alpha mod 5 = 0) and (alpha <> NumDirs) then

        writeln;

    end;

end;



Procedure First(InChar: char);

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

var

  index: integer;

  Match: boolean;

  TempNewDir: integer;

begin

  TempNewDir := NewDir;

  Match := false;

  for index := TempNewDir + 1 to NumDirs do

    if Dir[index, 1] = InChar then

      begin

        NewDir := index;

        Match := true;

        index := NumDirs;

      end;

  if not(Match) then

    for index := 1 to TempNewDir do

      if Dir[index, 1] = InChar then

        begin

          NewDir := index;

          Match := true;

          index := TempNewDir;

        end;

  if Match then

    WriteDirs(Bottom - ((NumDirs - 1) div 5))

  else

    Scrn.Beep;

end;



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

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

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

begin

  if WhereX <> 1 then

    writeln;

  write(MultiChar('=', 80));

  write('CH V4 David Croft (C) 1991.  ');

  writeln('Use 1st character, ', ArrowUpDown, ', ', ArrowLeftRight,

    ', SPACE, ENTER, and ESC.');

  write(MultiChar('=', 80));

  GetDir(0, NewDirStr);

  Center(NewDirStr);

  write(MultiChar('-', 80));

  repeat

    LoadDirs;

    NewDir := 1;

    WriteDirs(WhereY);

    Bottom := WhereY;

    repeat

      repeat

      until Keypressed;

      InChar := readkey;

      InChar := upcase(InChar);

      if InChar = #27 then

        halt;

      if InChar = #0 then

        begin

          ArrowChar := readkey;

          case ArrowChar of

            Up   :  if NewDir > 5 then

                      Dec(NewDir, 5);

            Down :  if NewDir <= NumDirs - 5 then

                      Inc(NewDir, 5);

            Right:  if (NewDir < NumDirs) and (NewDir mod 5 <> 0) then

                      Inc(NewDir);

            Left :  if (NewDir > 1) and (NewDir mod 5 <> 1) then

                      Dec(NewDir);

            else

              Scrn.Beep;

          end; {case}

          WriteDirs(Bottom - ((NumDirs - 1) div 5))

        end;

      if InChar in [

        'A'..'Z', '0'..'9', '_', '^', '$', Tilde, '!', '#', '%', '&',

          '-', '{', '}', '(', ')', '@', '''', GraveAccent, '.'] then

            First(InChar);

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

    writeln;

    ChDir(Dir[NewDir]);

    GetDir(0, NewDirStr);

    write(MultiChar('=', 80));

    Center(NewDirStr);

    write(MultiChar('-', 80));

  until InChar = #13;

end.