unit fselect;

interface

type
  t = record
       c : char;
       a : byte;
     end;

  Pfileselect_struct = ^Tfileselect_struct;
  Tfileselect_struct = record
     sx,sy   : integer;
     Path    : string;
     Mask    : string;
     Title  : string[25];
     fn      : array[1..30] of string [80];
     nofiles : integer;
   end;

   Pfilelist = ^Tfilelist;
   TFilelist = array[0..511] of string[12];

   Ppathlist = ^Tpathlist;
   TPathlist = array[0..511] of string[80];

   Psizelist = ^Tsizelist;
   Tsizelist = array[0..511] of longint;

   Pselectlist = ^Tselectlist;
   Tselectlist = array[0..511] of boolean;

   PAttriblist = ^TAttriblist;
   Tattriblist = array[0..511] of byte;


procedure select_packfiles(fs : Pfileselect_struct);
procedure display_ansi(p :pointer; mode : word);

var screen : array[1..50,1..80] of t absolute $B800:$0000;

implementation

uses dos,design,crt;

var fnames         : PFilelist;
    fpath          : PPathlist;
    fsize          : PSizelist;
    fselected      : PSelectlist;
    fattrib        : PAttriblist;

    dnames         : PFilelist;
    dsize          : PSizelist;
    dselected      : PSelectlist;
    dattrib        : PAttriblist;

     Start_Display  : integer;
    Cursor_Row   : integer;
    selectcount    : word;
    bytes_selected : longint;

var DirInfo: SearchRec;
    li : integer;
    count,
    fcount,
    dcount: integer;
    Nullpos : byte;
    ch : char;
    fscount : integer;
    curdir : string;
    savepath : string;
    marker : pointer;


{$L Fsel }
procedure fsel; external;

procedure waitretrace;
begin;
  asm
    MOV   DX,03dAh
@WD_R:
    IN    AL,DX
    TEST  AL,8d
    JZ    @WD_R
@WD_D:
    IN    AL,DX
    TEST  AL,8d
    JNZ   @WD_D
  end;
end;

procedure display_ansi(p :pointer; mode : word);
begin;
  textmode(mode);
  move(p^,ptr($b800,0)^,8000);
end;


procedure sort_filenames(start,end1 : integer);
{
 Quick-Sort should be built in here for larger directories !
}
var help : string;
    hsize : longint;
    l1,l2 : integer;
begin;
  for l1 := start to end1-1 do begin;
    for l2 := start to end1-1 do begin;
      if fnames^[l2] > fnames^[l2+1] then begin;
          help := fnames^[l2];
          fnames^[l2] := fnames^[l2+1];
          fnames^[l2+1] := help;

          hsize        := fsize^[l2];
          fsize^[l2]   := fsize^[l2+1];
          fsize^[l2+1] := hsize;

          hsize           := fattrib^[l2];
          fattrib^[l2]    := fattrib^[l2+1];
          fattrib^[l2+1]  := hsize;
        end;
      end;
    end;
end;


procedure sort_dirnames(start,end1 : integer);
{
 Quick-Sort should be built in here for larger directories !
}
var help : string;
    hsize : longint;
    l1,l2 : integer;
begin;
  for l1 := start to end1-1 do begin;
    for l2 := start to end1-1 do begin;
      if dnames^[l2] > dnames^[l2+1] then begin;
          help := dnames^[l2];
          dnames^[l2] := dnames^[l2+1];
          dnames^[l2+1] := help;

          hsize        := dsize^[l2];
          dsize^[l2]   := dsize^[l2+1];
          dsize^[l2+1] := hsize;

          hsize           := dattrib^[l2];
          dattrib^[l2]    := dattrib^[l2+1];
          dattrib^[l2+1]  := hsize;
        end;
      end;
    end;
end;


procedure draw_files(sx,sy : integer; fs : Pfileselect_struct);
var li : integer;
begin;
   waitretrace;

   textcolor(7);
   textbackground(black);
   for li := 1 to 11 do begin;
     fillchar(screen[sy+li,20].c,100,0);
     gotoxy(sx+2,sy+li);
     if fselected^[Start_Display+li] then begin;
       write('û ');
     end else begin;
       write('  ');
     end;
     write(fnames^[Start_Display+li]);
     while wherex < sx+2+16 do write(' ');
     if (fattrib^[Start_Display+li] and $10) = $10 then begin;
       write('        DIR  ');
     end else begin;
       write(fsize^[Start_Display+li]:7,' Bytes');
     end;
   end;

   move(marker^,screen[sy+Cursor_Row,20].c,100);

   textcolor(5); textbackground(black);
   gotoxy(sx+2,sy+Cursor_Row);
   if fselected^[Start_Display+Cursor_Row] then begin;
     write('û ');
   end else begin;
     write('  ');
   end;
   write(fnames^[Start_Display+Cursor_Row]);
   while wherex < sx+2+16 do write(' ');
   if (fattrib^[Start_Display+Cursor_Row] and $10) = $10 then begin;
     write('        DIR  ');
   end else begin;
     write(fsize^[Start_Display+Cursor_Row]:7,' Bytes');
   end;
end;

procedure append_dirnames(number : word);
var li : integer;
begin;
  for li := 1 to number do begin;
    fnames^[fcount+li-1] := dnames^[li];
    fsize^[fcount+li-1] := dsize^[li];
    fattrib^[fcount+li-1] := dattrib^[li];
  end;
end;


procedure read_directory(fs : Pfileselect_struct);
var curpath : string;
begin;
  {$I+}
  for li := 0 to 511 do fnames^[li]  := ' - - -';
  for li := 0 to 511 do fsize^[li]   := 0;
  for li := 0 to 511 do fattrib^[li] := 0;
  for li := 0 to 511 do dattrib^[li] := 0;
  for li := 0 to 511 do dnames^[li]  := ' - - -';
  for li := 0 to 511 do dsize^[li]   := 0;

  fcount := 1;
  dcount := 1;

  FindFirst(fs^.mask,255, DirInfo);
  while DosError = 0 do
  begin
    if ((DirInfo.attr and $10) = $10) then begin;
      dattrib^[dcount] := DirInfo.attr;
      dnames^[dcount]  := DirInfo.Name;
      dsize^[dcount]   := DirInfo.size;
      Nullpos := pos(#0,dnames^[dcount]);
      if Nullpos <> 0 then
        dnames^[dcount] := copy(dnames^[dcount],0,Nullpos-1);
      inc(dcount);
    end else begin;
      fattrib^[fcount] := DirInfo.attr;
      fnames^[fcount]  := DirInfo.Name;
      fsize^[fcount]   := DirInfo.size;
      Nullpos := pos(#0,fnames^[fcount]);
      if Nullpos <> 0 then
        fnames^[fcount] := copy(fnames^[fcount],0,Nullpos-1);
      inc(fcount);
    end;
    FindNext(DirInfo);
  end;
  {$I-}
  sort_filenames(1,fcount-1);
  sort_dirnames(1,dcount-1);
  append_dirnames(dcount);

  getdir(0,curpath);
  count := fcount + dcount - 1;

  for li := 0 to 511 do fselected^[li] := false;
  for li := 0 to 511 do dselected^[li] := false;
  for li := 0 to 511 do fpath^[li] := curpath;

 Start_Display := 0;
 Cursor_Row  := 1;
end;

procedure new_readin(fs : Pfileselect_struct);
begin;
  read_directory(fs);
  draw_files(fs^.sx,fs^.sy,fs);
  selectcount := 0;
end;

procedure shorten_direntry(fs : Pfileselect_struct);
var last_slashpos : integer;
    hs : string;
begin;
  hs := '';
  while pos('\',fs^.path) <> 0 do begin;
    last_slashpos := pos('\',fs^.path);
    hs := hs+copy(fs^.path,1,last_slashpos);
    delete(fs^.path,1,last_slashpos);

   gotoxy(1,23);
   write('                                                            ');
   gotoxy(1,23);
   write(fs^.path);

  end;
  if hs[length(hs)] = '\' then hs := copy(hs,1,length(hs)-1);
  fs^.path := hs;
  gotoxy(1,23);
  write('                                                            ');
  gotoxy(1,23);
  write(hs);
end;

procedure get_liner;
begin;
  getmem(marker,100);
  move(screen[13,20].c,marker^,100);
end;

procedure select_packfiles(fs : Pfileselect_struct);
var selection_end : boolean;
    nextpath : string;
begin;
  new(fnames);
  new(fsize);
  new(fselected);
  new(fpath);
  new(fattrib);

  new(dnames);
  new(dsize);
  new(dselected);
  new(dattrib);

  getdir(0,savepath);
  chdir(fs^.path);

  display_ansi(@fsel,co80);
  get_liner;
  cursor_off;

  inc(fs^.sy,2);

  read_directory(fs);

 ch := #0;
 draw_files(fs^.sx,fs^.sy,fs);
 selection_end := false;
 while not selection_end do begin;
   ch := readkey;
   if ch = #0 then ch := readkey;
   case ch of
     #13,
     #27 : begin;
             if (fattrib^[Start_Display+Cursor_Row] and $10 = 10)
             then begin;
               nextpath := fnames^[Start_Display+Cursor_Row];
               if nextpath = '..' then begin;
                 chdir('..');
                 shorten_direntry(fs);
                 new_readin(fs);
               end else begin;
                 if fs^.path[length(fs^.path)] <> '\' then
                 fs^.path := fs^.path + '\';
                 fs^.path :=  fs^.path+nextpath;
                 chdir(fs^.path);
                 new_readin(fs);
               end;
             end else begin;
               selection_end := true;
             end;
           end;
     #72 : begin; { Arrow up }
             if Cursor_Row > 1 then begin;
               dec(Cursor_Row);
             end else begin;
               if Start_Display > 0 then dec(Start_Display);
             end;
           end;

     #73 : begin; { Page up }
             if Start_Display > 11+Cursor_Row then begin;
               dec(Start_Display,11);
             end else begin;
               if Start_Display > 11 then begin;
                 dec(Start_Display,11);
                 Cursor_Row := Start_Display+0;
               end else begin;
                 Start_Display := 0;
                 Cursor_Row := 1;
               end;
             end;
           end;

     #80 : begin; { Arrow down }
             if Cursor_Row < 11 then begin;
               inc(Cursor_Row);
             end else begin;
               if Start_Display < count-12 then inc(Start_Display);
             end;
           end;

     #81 : begin; { Page down }
             if Start_Display+25 < count then begin;
               inc(Start_Display,11);
             end else begin;
                 Start_Display := count-12;
                 Cursor_Row := 11;
             end;
           end;

     #71 : begin;
             Start_Display := 0;
             Cursor_Row  := 1;
           end;

     #79 : begin;
             Start_Display := count - 12;
             Cursor_Row  := 11;
           end;


     #32 : begin; { Space }
             if fselected^[Start_Display+Cursor_Row] then begin;
               fselected^[Start_Display+Cursor_Row] := false;
               dec(selectcount);
               dec(bytes_selected,fsize^[Start_Display+Cursor_Row]);
              end else begin;
               fselected^[Start_Display+Cursor_Row] := true;
               inc(selectcount);
               inc(bytes_selected,fsize^[Start_Display+Cursor_Row]);
               getdir(0,fpath^[Start_Display+Cursor_Row]);
             end;
           end;
   end;
   draw_files(fs^.sx,fs^.sy,fs);
 end;

 fs^.nofiles := 0;
 for li := 0 to 511 do begin;
   if fselected^[li] then begin;
     inc(fs^.nofiles);
     fs^.fn[fs^.nofiles] := fpath^[li]+'\'+fnames^[li];
   end;
 end;

  chdir(savepath);
  dispose(fnames);
  dispose(fsize);
  dispose(fselected);
  dispose(fpath);
  dispose(fattrib);

  dispose(dnames);
  dispose(dsize);
  dispose(dselected);
  dispose(dattrib);
end;

begin;
end.
