unit grpfile;
interface
uses objects;

const
     grpOK        = 0;                      {vse v poradku}

     grpCreate    = $3c00;                  {vytvori novy soubor}
     grpOpenRead  = $3d00;                  {jen pro cteni}
     grpOpenWrite = $3d01;                  {jen pro zapis}
     grpOpen      = $3d02;                  {cteni i zapis}

     {$IFNDEF FPC}
     stOpenError = -8;
     {$ENDIF}

     MAX_GRP_CISLOVANYCH_SOUBORU = 99;

type

     PGRP_zaznamy = ^TGRP_zaznamy;
     TGRP_zaznamy = array[1..MAX_GRP_CISLOVANYCH_SOUBORU] of
        packed record
        oznaceni:byte;
        nazev:string[12];
        end;

     TGRPmapa = object
       num:byte;
       zaznam:PGRP_zaznamy;
       __vel:longint;
       Procedure Init(n:byte);
       Procedure Setrid;
       Function Dej_nazev(n:byte):string;
       Function Dej_oznaceni(n:byte):byte;
       Procedure Done;
       end;

     PGrpStream = ^TGrpStream;
     TGrpStream = object (TDOSStream)
     is_grp:boolean;
     numfiles:longint;
     StartPos:longint;
     LocalSize:longint;
     Constructor Init (FileName: FNameStr; Mode:word);
     Procedure NactiVnitrek(name:string;poz:longint);
     Destructor Done;virtual;
     Procedure Seek (Poz: LongInt);Virtual;
     {$IFDEF FPC}
     Procedure Read (Var Buf; Count: longint);Virtual;
     {$ELSE}
     Procedure Read (Var Buf; Count: word);Virtual;
     {$ENDIF}
     Function GetSize:longint;virtual;
     Function GetPos:longint;virtual;
     Function ReadStream(var Buf; Count:longint):longint;

     Function Jsem_v_GRP:boolean;
     Function Jsem_ja_GRP:boolean;
     Function Kolik_ja_mam_v_GRP:longint;

     Procedure Jak_ja_obsahuju_cislovane_soubory(var m:TGRPmapa);
     end;


implementation
uses Dos;

const MAGIC = 'KenSilverman';
      VELIKOSTZAHLAVI = 12+4;

Function Convert_Up(s:string):string;
var a:byte;
begin
for a:=1 to Length(s) do s[a]:=UpCase(s[a]);
Convert_Up:=s;
end;

function SkipEndSpaces(s:string):string;
var i:byte;
begin
i:=Length(S);
while (S[i] in [' ',#0]) and (i>0) do Dec (i);
s[0]:=char(i);
SkipEndSpaces:=s;
end;  { SkipEndSpaces }


Constructor TGrpStream.Init(FileName: FNameStr; Mode: Word);
var a:byte;
    s:string;
begin
is_grp:=false;
FileName:=FExpand(Convert_UP(FileName));

a:=Pos('#',Filename);                     {budeme to otevirat jako normalni}
if a=0 then
   begin
   inherited Init(FileName,mode); {soubor nebo jako soubor v archivu?}
   StartPos:=inherited GetPos;
   LocalSize:=inherited GetSize;
   end
   else begin
   s:=Copy(FileName,1,a-1);
   inherited Init(s,mode);
   if status<>stOK then Exit;           {nepodarilo se otevrit .GRP archiv}

   filename:=Copy(filename,a+1,255);
   NactiVnitrek(filename,0);
   end;
end;


Procedure TGrpStream.NactiVnitrek(name:string;poz:longint);
{Rekurzivni procedura, ktera se prokouse zapisem jako:
'ARCHIV.GRP#BITMPFNT.MFN#size12.fn'}
var n:string[12];
    a,b:byte;
    ourname,nextname:string;

begin
inherited Read(n[1],12);
n[0]:=#12;
if MAGIC<>n then begin
   status:=stOpenError; {nejde o Duke3D .GRP format}
   Exit;
   end;

{overili jsme "magic" archivu}
is_grp:=true;
a:=Pos('#',name);
if a=0 then
   begin
   ourname:=name;
   nextname:='';
   end
   else begin
   ourname:=Copy(name,1,a-1);
   nextname:=Copy(name,a+1,255);
   end;
inherited Read(numfiles,4);
for b:=1 to numfiles do
    begin
    n[0]:=#12;
    inherited Read(n[1],12);
    n:=Convert_Up(SkipEndSpaces(n));
    inherited Read(localsize,4);
    if n=ourname then
       begin
       startpos:=VELIKOSTZAHLAVI+numfiles*16+poz;
       inherited Seek(startpos);
       if a=0 then status:=stOK
              else NactiVnitrek(nextname,startpos);
       Exit;
       end;
    inc(poz,localsize);
    end;
status:=stOpenError;             {soubor tohoto jmena v archivu neni}
end;


Destructor TGrpStream.Done;
begin
{Close;}
inherited Done;
end;


Procedure TGrpStream.Seek(poz:longint);
begin
if Poz<0 then Poz:=0;
if Poz>LocalSize then Poz:=LocalSize;
inc(poz,StartPos);
inherited Seek(poz);
end;


{$IFDEF FPC}
Procedure TGrpStream.Read (Var Buf; Count: longint);
{$ELSE}
Procedure TGrpStream.Read (Var Buf; Count: word);
{$ENDIF}
var local:longint;
begin
if is_grp=false then inherited Read(buf,count)
   else begin
   local:=inherited GetPos - StartPos;

   if local+count>LocalSize
      then status:=stReadError
      else inherited Read(buf,count);
   end;
end;


Function TGrpStream.GetSize:longint;
begin
GetSize:=LocalSize;
end;


Function TGrpStream.GetPos:longint;
var i:longint;
begin
if is_grp=false then GetPos:=inherited GetPos
   else begin
   i:=inherited GetPos;
   GetPos:=i-StartPos;
   end;
end;


Function TGrpStream.ReadStream(var Buf; Count:longint):longint;
var l:longint;
begin
l:=GetPos;
Read(buf,count);
if status<>stOK then
   begin
   reset;
   l:=GetSize-l;
   Read(buf,l);
   end else l:=count;
ReadStream:=l;
end;


Function TGrpStream.Jsem_v_GRP:boolean;
begin
Jsem_v_GRP:=is_grp;
end;


Function TGrpStream.Jsem_ja_GRP:boolean;
var l:longint;
    n:string[12];
begin
if GetSize<20 then begin Jsem_ja_GRP:=false;Exit;end;
l:=GetPos;
Seek(0);
Read(n[1],12);
n[0]:=#12;
Jsem_ja_GRP:=MAGIC=n;
Seek(l);
end;


Function TGrpStream.Kolik_ja_mam_v_GRP:longint;
var l,m:longint;
    n:string[12];
begin
if GetSize<20 then begin Kolik_ja_mam_v_GRP:=0;Exit;end;
l:=GetPos;
Seek(0);
Read(n[1],12);
n[0]:=#12;
if n<>MAGIC then begin Seek(l);Kolik_ja_mam_v_GRP:=0;Exit;end;
Read(m,4);
Seek(l);
Kolik_ja_mam_v_GRP:=m;
end;


Function Separuj_z_nazvu_cislo(n:string):longint;
  function pow10(w:byte):longint;
  var aa:byte;
      bb:longint;
  begin
  if w=0 then pow10:=1
     else begin
     bb:=1;
     for aa:=1 to w do bb:=bb*10;
     pow10:=bb;
     end;
  end;

var a,b:byte;
    c,g:byte;
    i:longint;
begin
i:=0;

a:=Pos('.',n);
if a>0 then delete(n,a,255);

g:=Length(n);
for a:=g downto 1 do
    begin
    c:=byte(n[a]);
    if (c>47) and (c<58) then
       begin
       dec(c,48);
       i:=i+c*pow10(g-a);
       end else Break;
    end;
Separuj_z_nazvu_cislo:=i;
end;


Procedure TGrpStream.Jak_ja_obsahuju_cislovane_soubory(var m:TGRPmapa);
var i,a,z,y,x:longint;
    b:longint;
    s:string;
    temp:TGRPmapa;
begin
i:=Kolik_ja_mam_v_GRP;
if i>0 then  {ted vim, ze mam v sobe nejake vnorene soubory...}
   begin     {...ale ktere z jsou s cislovkou na konci?}
   x:=0;
   Seek(16);     {ted jsem na jmenu prvniho souboru}
   z:=16+i*16;   {pozice prvniho archivovaneho souboru}

   temp.init(i); {provizorni misto na ulozeni zaznamu}

   for a:=1 to i do
       begin
       s[0]:=#12;
       Read(s[1],12);
       s:=skipendspaces(s);
       Read(y,4);
       b:=Separuj_z_nazvu_cislo(s);
       if b>0 then
          begin
          inc(x);   {nalezli jsme dalsi ocislovany soubor}
          temp.zaznam^[x].nazev:=s;
          temp.zaznam^[x].oznaceni:=b;
          end;
       inc(z,x);
       end;

   m.init(x);

   for b:=1 to x do
       begin
       m.zaznam^[b].nazev:=temp.zaznam^[b].nazev;
       m.zaznam^[b].oznaceni:=temp.zaznam^[b].oznaceni;
       end;

   temp.done;

   m.Setrid;

   end else m.num:=0;

{
for b:=1 to numfiles do
    begin
    n[0]:=#12;
    inherited Read(n[1],12);
    n:=Convert_Up(SkipEndSpaces(n));
    inherited Read(localsize,4);
    if n=ourname then
       begin
       startpos:=VELIKOSTZAHLAVI+numfiles*16+poz;
       inherited Seek(startpos);
       if a=0 then status:=stOK
              else NactiVnitrek(nextname,startpos);
       Exit;
       end;
    inc(poz,localsize);
    end;
}

end;




Procedure TGRPmapa.Init(n:byte);
begin
__vel:=0;
num:=n;
if num>0 then
   begin
   __vel:=num*14;
   GetMem(zaznam,__vel);
   end;
end;


Procedure TGRPmapa.Setrid;
var hotovo:boolean;
    a:longint;
    oz:longint;
    na:string;
begin
repeat
  hotovo:=true;
  for a:=1 to num-1 do
      if zaznam^[a].oznaceni>zaznam^[a+1].oznaceni then
         begin
         oz:=zaznam^[a].oznaceni;
         zaznam^[a].oznaceni:=zaznam^[a+1].oznaceni;
         zaznam^[a+1].oznaceni:=oz;

         na:=zaznam^[a].nazev;
         zaznam^[a].nazev:=zaznam^[a+1].nazev;
         zaznam^[a+1].nazev:=na;
         hotovo:=false;
         end;
until hotovo=true;
end;


Function TGRPmapa.Dej_nazev(n:byte):string;
begin
if (n=0) or (n>num) then Dej_nazev:='' else Dej_nazev:=zaznam^[n].nazev;
end;


Function TGRPmapa.Dej_oznaceni(n:byte):byte;
begin
if (n=0) or (n>num) then Dej_oznaceni:=0 else Dej_oznaceni:=zaznam^[n].oznaceni;
end;


Procedure TGRPmapa.Done;
begin
if __vel>0 then begin num:=0;FreeMem(zaznam,__vel);__vel:=0;end;
end;


end.
