PC Interdit/pc-interdit.iso/sound/gusmod/fselect.pas

Pascal/Delphi Source File | 1994-10-26 | 11KB | 436 lines

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;
     Titre   : string[25];
     fn      : array[1..30] of string [80];
     nofiles : integer;
   end;

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

   Ppfadliste = ^Tpfadliste;
   TPfadliste = array[0..511] of string[80];

   Psizeliste = ^Tsizeliste;
   Tsizeliste = array[0..511] of longint;

   Pselectliste = ^Tselectliste;
   Tselectliste = array[0..511] of boolean;

   PAttribliste = ^TAttribliste;
   Tattribliste = array[0..511] of byte;


procedure select_packfichiers(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;
    fpfad          : PPfadliste;
    fsize          : PSizeliste;
    fselected      : PSelectliste;
    fattrib        : PAttribliste;

    dnames         : PFilelist;
    dsize          : PSizeliste;
    dselected      : PSelectliste;
    dattrib        : PAttribliste;

    Start_Indication  : integer;
    Ligne_Curseur   : 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 c:\edition\prog\fr\asm\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,fin : integer);
{
 Pour un fichier plus grand, utiliser Quick-Sort !
}
var Aide  : string;
    hsize : longint;
    l1,l2 : integer;
begin;
  for l1 := start to fin-1 do begin;
    for l2 := start to Fin-1 do begin;
      if fnames^[l2] > fnames^[l2+1] then begin;
          Aide := fnames^[l2];
          fnames^[l2] := fnames^[l2+1];
          fnames^[l2+1] := aide;

          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,fin : integer);
var aide : string;
    hsize : longint;
    l1,l2 : integer;
begin;
  for l1 := start to fin-1 do begin;
    for l2 := start to fin-1 do begin;
      if dnames^[l2] > dnames^[l2+1] then begin;
          Aide := dnames^[l2];
          dnames^[l2] := dnames^[l2+1];
          dnames^[l2+1] := Aide;

          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_Indication+li] then begin;
       write('√ ');
     end else begin;
       write('  ');
     end;
     write(fnames^[Start_Indication+li]);
     while wherex < sx+2+16 do write(' ');
     if (fattrib^[Start_Indication+li] and $10) = $10 then begin;
       write('        DIR  ');
     end else begin;
       write(fsize^[Start_Indication+li]:7,' Octets');
     end;
   end;

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

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

procedure append_dirnames(Quantite : word);
var li : integer;
begin;
  for li := 1 to Quantite 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 fpfad^[li] := curpath;

 Start_Indication := 0;
 Ligne_Curseur  := 1;
end;

procedure Nouv_Fam(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_packfichiers(fs : Pfileselect_struct);
var Choix_quitter : boolean;
    nextpath : string;
begin;
  new(fnames);
  new(fsize);
  new(fselected);
  new(fpfad);
  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);
 Choix_quitter := false;
 while not Choix_quitter do begin;
   ch := readkey;
   if ch = #0 then ch := readkey;
   case ch of
     #13,
     #27 : begin;
             if (fattrib^[Start_Indication+Ligne_Curseur] and $10 = 10)
             then begin;
               nextpath := fnames^[Start_Indication+Ligne_Curseur];
               if nextpath = '..' then begin;
                 chdir('..');
                 shorten_direntry(fs);
                 Nouv_Fam(fs);
               end else begin;
                 if fs^.path[length(fs^.path)] <> '\' then
                 fs^.path := fs^.path + '\';
                 fs^.path :=  fs^.path+nextpath;
                 chdir(fs^.path);
                 nouv_fam(fs);
               end;
             end else begin;
               Choix_quitter := true;
             end;
           end;
     #72 : begin;
             if Ligne_Curseur > 1 then begin;
               dec(Ligne_Curseur);
             end else begin;
               if Start_Indication > 0 then dec(Start_Indication);
             end;
           end;

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

     #80 : begin;
             if Ligne_Curseur < 11 then begin;
               inc(Ligne_Curseur);
             end else begin;
               if Start_Indication < count-12 then inc(Start_Indication);
             end;
           end;

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

     #71 : begin;
             Start_Indication := 0;
             Ligne_Curseur  := 1;
           end;

     #79 : begin;
             Start_Indication := count - 12;
             Ligne_Curseur  := 11;
           end;


     #32 : begin; { Space }
             if fselected^[Start_Indication+Ligne_Curseur] then begin;
               fselected^[Start_Indication+Ligne_Curseur] := false;
               dec(selectcount);
               dec(bytes_selected,fsize^[Start_Indication+Ligne_Curseur]);
              end else begin;
               fselected^[Start_Indication+Ligne_Curseur] := true;
               inc(selectcount);
               inc(bytes_selected,fsize^[Start_Indication+Ligne_Curseur]);
               getdir(0,fpfad^[Start_Indication+Ligne_Curseur]);
             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] := fpfad^[li]+'\'+fnames^[li];
   end;
 end;

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

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

begin;
end.