unit dira;

interface
procedure dirf(var c:string; cp:char);
implementation
uses crt,dos;
var p:string;
    f:array [0..999] of string[12];        {(0..143)}
    a:array [0..999] of byte;
    r:searchrec;
    i,q,s,l:byte;
    j,x,k:integer;
    ch:char;
    lo:longint;

procedure get(cp:char);
begin
   findfirst(p+'\*.*',$3F,r);
   k:=l;
   repeat
      if (r.name[1]<>'.') and ((r.name[length(r.name)-2]=cp) or (r.attr=$10)) then begin
         inc(k);
         f[k]:=r.name;
         if r.attr=$10 then a[k]:=10 else a[k]:=0;
         if ((k+1)/143=trunc((k+1)/143)) and (doserror=0) then begin inc(k);f[k]:='  [MORE]';a[k]:=11; end;
      end;
      findnext(r);
   until (k=998) or (doserror=18);
   inc(k);f[k]:='  [HOME]';a[k]:=12;
   s:=0;
end;

procedure ki(gy:byte);
begin
   textbackground(gy);
   q:=7;
   if a[j+s*144]=1 then q:=12;
   if a[j+s*144] in [11,12] then q:=13;
   if a[j+s*144]=10 then q:=14;

   textcolor(q);
   gotoxy(trunc((j)/24)*13+1,j-trunc((j)/24)*24+2);write(f[j+s*144]);
end;

procedure kep;
begin
   j:=0;
   textcolor(7);textbackground(0);
   clrscr;
   textcolor(9);writeln(p);
   textcolor(15);
   textcolor(7);
   if s*144>k-143 then i:=k-s*144 else i:=143;
   for q:=0 to i do begin
      if a[q+s*144]=10 then textcolor(14);
      if a[q+s*144] in [11,12] then textcolor(13);
      if a[q+s*144]=0 then textcolor(7);
      if a[q+s*144]=1 then textcolor(12);
      gotoxy(trunc((q)/24)*13+1,q-trunc((q)/24)*24+2);write(f[q+s*144]);
   end;
   ki(1);
end;

procedure fo(var c:string;cp:char);
begin
kep;
repeat
   ch:=readkey;if ch=#0 then ch:=readkey;
   if ch in [#80,#77,#75,#72] then ki(0);
   if ch=#72 then begin dec(j);if j<0 then j:=i; end;
   if ch=#77 then begin inc(j,24);if j>i then j:=j-trunc((j)/24)*24; end;
   if ch=#75 then begin dec(j,24);if j<0 then begin j:=trunc((i)/24)*24+j+24; if j>i then dec(j,24);end; end;
   if ch=#13 then begin
      if j<=l then
      begin
         if j=0 then
         begin if (p[0]>#3) and (s=0) then begin
            repeat
               dec(p[0]);
            until p[ord(p[0])+1]='\';
            get(cp);
            kep;
         end;end
         else
              if s=0 then begin p:=f[j,6]+':';get(cp);kep;end;
      end else begin if a[j+s*144]=10 then begin p:=p+'\'+f[j+s*144];get(cp);kep;end;
              if a[j+s*144] in [0,1] then begin c:=p+'\'+f[j+s*144];ch:=#27; end;
           end;
      if a[j+s*144]=12 then begin s:=0;kep; end;
      if a[j+s*144]=11 then begin inc(s);kep; end;
   end;
   if ch=#80 then begin inc(j);if j>i then j:=0; end;


   ki(1);
until ch=#27;
end;





{\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}

procedure dirf;
begin
   textcolor(7);textbackground(0);
   clrscr;

   f[0]:='..';a[0]:=10;
   f[1]:='  [  A: ]';a[1]:=10;
   f[2]:='  [  B: ]';a[2]:=10;

   l:=2;
   for q:=3 to 25 do begin lo:=diskfree(q); 
       if lo>-1 then
       begin inc(l);f[l]:='  [  '+chr(q+64)+': ]';a[l]:=10 end; end;

   c:='';
   getdir(0,p);

   get(cp);

   repeat
      fo(c,cp);

   until ch=#27;


   textcolor(7);textbackground(0);
end;

begin
end.