{$N+,A+,G+,F+,D-,E-,L-,R-,S-,Q-,Y-,I-}

unit resource;

interface

procedure res_reg(num_scene:byte; name, filename:string; length:longint; pak_flag:byte);
Function LoadBin(name:string; where, ofset:word):longint;
Procedure LoadBinAdvance(found:word; read_offset,length:longint; where, ofset:word);
Procedure LoadBinFromFile(name:string; where, ofset:word);
Procedure LoadFilesToXMS(buf:word);
Procedure LoadBufferToXMS(name:string;length:longint; buf:word);
Procedure LoadBufferFromXMS(name:string; where, ofset:word);
Procedure AllocateXMSforAll;
procedure setup_df_offsetes; {set offsets in general data-file to res array}
procedure loadscreen_progressbar(q:single);
function  index_resource(name:string):integer; {find index of resource by name}
procedure ErrorLoading(message:string; code:integer);
function DecompressRLE(from, dest: word): longint;
procedure LoadBinUnpack(name:string; buf, where, offs:word);


implementation
uses global, xms2, midas, timer;

{---------------------------------------------------------------}
{$I demoded.res}  {offset of resources in data-files information!}
{----------------------------------------------------------------}

var progressbar_q:single;
res_filenames:array[1..count_res] of string[filenames_size_array];


Procedure ErrorLoading(message:string; code:integer);
begin
 if MusicStart=1 then begin
        tmrStopScrSync;
        midasStopModule(module);            { stop playing }
        midasFreeModule(module);            { deallocate module }
        midasClose;                         { uninitialize MIDAS }
        end;

 asm {if not text-mode then setup text-mode}
  mov ah, 0fh
  int 10h
  cmp al, 3
  je @skip
     mov ax, 03h
     int 10h
  @skip:
 end;

 WriteLn(message, code);
 if UseXMS=1 then FreeXMS;
 Halt;
end;


procedure loadscreen_progressbar(q:single);
var n:byte;
begin
  progress:=progress+q;
  if round(progress)<=32 then begin
     for n:=0 to round(progress) do begin
            Port[$3C8]:=255-32+n;
            Port[$3C9]:=progressbar_color.r;
            Port[$3C9]:=progressbar_color.g;
            Port[$3C9]:=progressbar_color.b;
         end;
  end;
end;


function index_handle(handle:word):integer; {find index of handle}
var n:byte; found:integer;
begin
  found:=-1;
  for n:=1 to 32 do
     if handler_list[n]=handle then
        begin
          found:=n;
          break;
        end;
  index_handle:=found;
end;

function index_resource(name:string):integer; {find index of resource by name}
var n, found:integer;
begin
  found:=-1;
  for n:=1 to res_counter do
     if name = res_names[n] then
        begin
          found:=n;
          break;
        end;
  index_resource:=found;
end;



procedure setup_df_offsetes;
var
n:word;
found:integer;
begin
  for n:=1 to num_of_fileresource do
  begin
      with resource_info[n] do
      begin
         found:=index_resource(name);
         if (found<0) then ErrorLoading('Resource not found! (setup_offsets): '+name,0);
         res_df_offset[found]:=offset; {set offset in general datafile}
      end;
  end;
end;


procedure res_reg(num_scene:byte; name, filename:string; length:longint; pak_flag:byte);
begin
inc(res_counter);
if (res_counter>count_res) then ErrorLoading('Count of resource overflow:', res_counter);
res_numscene[res_counter]:=num_scene;
res_names[res_counter]:=name;
if release_mode=1 then res_filenames[res_counter]:=filename[1]
                  else res_filenames[res_counter]:=filename;
res_length[res_counter]:=length;
res_handler[res_counter]:=0;
res_offset[res_counter]:=0;
res_packed[res_counter]:=pak_flag;
end;


function ReadFileAdvance(name:string; read_offset,length:longint; seg_write, write_offset:word):shortint;
var
fr:file;
buf:longint;
b:byte;
n,m:word;
l:longint;
found:integer;
reading_offset:longint;
begin
  found:=-1;
  found:=index_resource(name);
  if (found<0) then begin ReadFileAdvance:=1; exit; end;

  if (odd(length)) or (length<4) then begin ReadFileAdvance:=2; exit; end;

  if (General_datafile_mode = 0) then Assign(fr, res_filenames[found])
  else Assign(fr, General_datafile_name);

  FileMode:=0; {open file read only}
  Reset(fr, 1);
  if IOResult<>0 then begin ReadFileAdvance:=3; exit; end;

  if (General_datafile_mode = 0) then reading_offset:=read_offset
  else reading_offset:=res_df_offset[found] + read_offset;

  if reading_offset>0 then Seek(fr, reading_offset);
  if IOResult<>0 then begin ReadFileAdvance:=4; exit; end;

  n:=0;
  for l:=1 to (length div 4) do
     begin
        BlockRead(fr, buf, 4);
        if IOResult<>0 then begin ReadFileAdvance:=5; exit; end;
        meml[seg_write:n+write_offset]:=buf;
        inc(n, 4);
     end;
  if (length and 3) <> 0 then begin {dochityvaem ostatok}
       for l:=1 to (length and 3) do
           begin
               BlockRead(fr, b, 1);
               if IOResult<>0 then begin ReadFileAdvance:=5; exit; end;
               mem[seg_write:n+write_offset]:=b;
               inc(n);
           end;
  end;

  Close(fr);
  if IOResult<>0 then begin ReadFileAdvance:=6; exit; end;

  ReadFileAdvance:=0;
end;



Procedure AllocateXMSforAll;  {allocate XMS-memory for all resources}
var handler, n, alloc_size, res,scene, max_scene_num:word;
sum_size, all_allocate:longint;
s:single;
begin
  all_allocate:=0;
  Handler_counter:=0;
  for n:=0 to 31 do Handler_list[n]:=0; {clear handler-list array}
  for n:=0 to 31 do Handler_fillsize[n]:=0;

  max_scene_num:=0;
  {find max scene number}
  for n:=1 to res_counter do if max_scene_num<res_numscene[n] then max_scene_num:=res_numscene[n];

  for scene:=0 to max_scene_num do begin
     sum_size:=0;

     {find all resource of scene, and allocate one summary XMS-block}
     for res:=1 to res_counter do
     begin
       if (res_numscene[res] = scene) then sum_size:=sum_size+res_length[res];
     end;

     {allocate XMS-memory}
     if sum_size>0 then
     begin
        s:=sum_size/1024;
        alloc_size:=trunc(s);
        if (s-alloc_size)>0 then alloc_size:=alloc_size+1;

        {try to allocate XMS-block for all resource of scene}
        Handler:=EMBGetMem(alloc_size);
        if XMSError<>0 then ErrorLoading('Error allocation XMS! Code:', XMSError);

        inc(Handler_counter);
        Handler_list[Handler_counter]:=Handler;

        if debug_mode=1 then WriteLn('Handler: ', Handler, ', ', alloc_size,'kb');{}
        all_allocate:=all_allocate+alloc_size;

        {set handler to all resources of scene}
        for res:=1 to res_counter do
          begin
            if (res_numscene[res] = scene) then res_handler[res]:=handler;
          end;
     end;
  end;

  if debug_mode=1 then WriteLn('All allocate: ', all_allocate,'kb');
end;



Procedure LoadFilesToXMS(buf:word);
var
l, XMSoffset:longint;
h, m, handle:word;
errors:shortint;

begin

  if debug_mode=0 then progressbar_q:=16/num_of_fileresource;

  for h:=1 to handler_counter do
  begin
      handle:=Handler_list[h];
      XMSOffset:=0;

      for m:=1 to res_counter do
       if handle=res_handler[m] then
        if res_filenames[m]<>'!' then
        begin
            errors:=ReadFileAdvance(res_names[m], 0, res_length[m], buf, 0);
            if errors>0 then ErrorLoading('File open error: '+res_names[m]+', Code:', errors);

            MoveToXMS_adv(buf,0, handle, XMSOffset, res_length[m]);

            if debug_mode=1 then
               WriteLn(m,'. ', res_names[m],', length=',res_length[m],', offset_xms=',XMSOffset,', Handle=',res_handler[m] )
            else loadscreen_progressbar(progressbar_q);

            if XMSError<>0 then ErrorLoading('Error load data to XMS! Code:',XMSError);

            res_offset[m]:=XMSOffset;
            XMSOffset:=XMSOffset+res_length[m];
            if odd(XMSOffset) then XMSOffset:=XMSOffset+1; {корректируем нечетность}
            handler_fillsize[h]:=XMSOffset;
        end;
  end;

  if debug_mode=0 then progressbar_q:=16/(res_counter-num_of_fileresource);

end;



Procedure LoadBufferToXMS(name:string;length:longint;buf:word);
var
  XMSoffset:longint;
  handle:word;
  found,index_h:integer;
begin
       if odd(length) then ErrorLoading('Resource length wrong: '+name+', Length:', length);

       found:=index_resource(name);
       if (found<0) then ErrorLoading('Resource not found: '+name+' Code:', 0);


       length:=res_length[found];
       handle:=res_handler[found];

       index_h:=index_handle(handle);
       if index_h<0 then ErrorLoading('Handle not found: ', handle);

       XMSOffset:=handler_fillsize[index_h];

       MoveToXMS_adv(buf,0, handle, XMSOffset, length);

       res_offset[found]:=XMSOffset;

       if debug_mode=1 then WriteLn(found,'. ', res_names[found],', length=',res_length[found],', offset_xms=',
           res_offset[found],', Handle=',res_handler[found])
       else loadscreen_progressbar(progressbar_q);

       if XMSError<>0 then ErrorLoading('Error load data to XMS! Code:',XMSError);

       XMSOffset:=XMSOffset+length;
       if odd(XMSOffset) then XMSOffset:=XMSOffset+1; {корректируем нечетность}

       handler_fillsize[index_h]:=XMSOffset;
end;




function LoadBin(name:string; where, ofset:word):longint;
var
  found:integer;
  errors:shortint;
begin

  found:=index_resource(name);
  if (found<0) then ErrorLoading('Resource not found: '+name+', Code: ', 0);

  if UseXMS=0 then
  begin
       errors:=ReadFileAdvance(res_names[found], 0, res_length[found], where, ofset);
       if errors>0 then ErrorLoading('File open error: '+res_names[found]+', Code:', errors);
  end
  else begin
       MoveFromXMS_adv(res_handler[found], where, ofset, res_offset[found], res_length[found]);
       if XMSError<>0 then ErrorLoading('Error load data from XMS! (bin) code:', XMSError);
  end;

  LoadBin:=res_length[found]; {return size}
end;

Procedure LoadBufferFromXMS(name:string; where, ofset:word);
var found:integer;
begin
  found:=index_resource(name);
  if (found<0) then ErrorLoading('Resource not found! (buffer)',0);

  MoveFromXMS_adv(res_handler[found], where, ofset, res_offset[found], res_length[found]);
  if XMSError<>0 then ErrorLoading('Error load data from XMS! (buffer) code:', XMSError);
end;


Procedure LoadBinAdvance(found:word; read_offset,length:longint; where, ofset:word);
var
read_offs:longint;
errors:shortint;
begin

{  found:=index_resource(name);
  if (found<0) then ErrorLoading('Resource not found!', 0);}

  if UseXMS=0 then
  begin
       errors:=ReadFileAdvance(res_names[found], read_offset, length, where, ofset);
       if errors>0 then ErrorLoading('File open error: '+res_names[found]+', Code:', errors);
  end
  else begin
       read_offs:=read_offset + res_offset[found];

       if (length>0) and (read_offset+length <= res_length[found])
       then
       MoveFromXMS_adv(res_handler[found], where, ofset, read_offs, length);
       if XMSError<>0 then ErrorLoading('Error load data from XMS! (binadv) code:', XMSError);
  end;
end;


Procedure LoadBinFromFile(name:string; where, ofset:word);
var
  found:integer;
  errors:shortint;
begin
  found:=index_resource(name);
  if (found<0) then ErrorLoading('Resource not found! Code:', 0);

  errors:=ReadFileAdvance(res_names[found], 0, res_length[found], where, ofset);
  if errors>0 then ErrorLoading('File open error: '+res_names[found]+', Code:', errors);
end;


function CRC16(size:longint; where: word): word;
var
  crc: Word;
  i, j: word;
  byteVal: Byte;
begin
  crc := $FFFF;  {start value}
  for i := 0 to word(size - 1) do
  begin
    byteVal := mem[where:i];
    crc := crc xor (byteVal shl 8);
    for j := 0 to 7 do
    begin
      if (crc and $8000) <> 0 then
        crc := (crc shl 1) xor $1021
      else
        crc := crc shl 1;
    end;
  end;
  CRC16 := crc;
end;


const
  Signature: array[0..2] of Char = ('7','p','k');

function DecompressRLE(from, dest: word): longint;
var
  packsize, crc, i, j: Word;
  outPtr, origLen:longint;
  cur, marker, count: Byte;
begin

  if debug_mode=1 then
  for i := 0 to 2 do
    if mem[from:i] <> byte(signature[i]) then
    begin
      {WriteLn('Signature fail');}
      DecompressRLE := 0;
      Exit;
    end;

  crc      := memW[from:3];
  origLen  := Longint(memW[from:5])+1;
  packsize := memW[from:7];
  marker   := mem[from:9];

  i := 10;
  outPtr := 0;

  asm
  push ds
  mov si, i
  mov di, word ptr outPtr
  mov dl, marker
  mov bx, packsize
  mov es, dest
  mov ds, from
  @mainloop:
       cmp si, bx {while i < packsize do begin}
       jae @exit

       db $66; mov ax, ds:[si]
       cmp al, dl {if mem[from:i] = marker then}
       jne @nopacked
       {begin}
           cmp ah, dl {if mem[from:i+1] = marker then}
           jne @no_marker_escaping
              {begin}
                 mov es:[di], dl {mem[dest:outPtr] := marker;}
                 inc di    {Inc(outPtr);}
                 jz @di_overflow
                 add si, 2 {Inc(i,2);}
                 jmp @mainloop
              {end;}
           @no_marker_escaping: {else}
              {begin}
                 {cur := mem[from:i+1];}
                 db $66; shr ax, 8 {count := mem[from:i+2];}
                 @depack: {for j := 1 to count do begin}
                     mov es:[di], al  {mem[dest:outPtr] := cur;}
                     inc di  {Inc(outPtr);}
                     jz @di_overflow
                     dec ah
                 jnz @depack {end;}
                 add si, 3 {Inc(i,3);}
                 jmp @mainloop
              {end;}
        {end}
        @nopacked:{else}
        {begin}
              mov es:[di], al {mem[dest:word(outPtr)] := mem[from:word(i)];}
              inc di            {inc(outPtr);}
              jz @di_overflow
              inc si            {inc(i);}
              jmp @mainloop
        {end;}
  @di_overflow:

  @exit:
  pop ds
  mov word ptr outPtr, di
  end; {end;}
  if outPtr=0 then outPtr:=65536;

  if outPtr<>origLen then begin DecompressRLE:=1; exit; end; {depack size wrong}

{  if debug_mode=1 then
  if crc<>crc16(outPtr, dest) then begin DecompressRLE:=2; exit; end; {crc wrong}

  DecompressRLE := outPtr;
end;


procedure LoadBinUnpack(name:string; buf, where, offs:word);
var error:longint;
begin
LoadBin(name,  buf,  0);
Error:= DecompressRLE(buf, where);
if error<3 then ErrorLoading('Error unpack data, code:', Error);
end;


begin

progress:=0;
general_datafile_mode:=0;
General_datafile_name:='demoded.dat';
Handler_counter:=0;
res_counter:=0;

end.