{tak tohle jsem vlastne udalal cely sam :-))) }
 
unit pcxunitz;



interface

procedure detectkeyboard;
procedure pcxvirt(jmeno:string;where:word);
procedure palpcx(jmeno:string);
procedure fade;
procedure flip32(source,dest:word);
procedure scrdown;
procedure scrup(from:word);

implementation
uses mygraph,crt;

procedure detectkeyboard;
begin
   if port[$60]=$01 then
   begin
    setVIDEO($03);
    halt(0);
   end;
end;


procedure pcxvirt(jmeno:string;where:word);

var f:file;
    temp1,temp2:byte;
    ukaz:pointer;
    vgapos,aktivni_data:word;
    i1,i2:word;

begin
assign(f,jmeno);
reset(f,1);
seek(f,128);                             {kasli na hlavicku}
aktivni_data:=filesize(f)-128-768;
getmem(ukaz,aktivni_data);
blockread(f,ukaz^,aktivni_data);
close(f);
vgapos:=0;
for i1:=0 to aktivni_data-1 do
 begin
  asm
   push ds
   mov si,word ptr ukaz     {offset ukazatele}
   mov ax,si
   add ax,i1
   mov si,ax                {oprava offsetu}
   mov ax, word ptr ukaz+2  {segment}
   mov ds,ax
   mov al,[ds:si]
   pop ds                   {na to bacha, nejdriv obnovit ds, aby byla}
   mov temp1,al             {globalni promena temp1 viditelna}
  end;
  if ((temp1 and 192)=192) then
   begin                         {komprese , cti dalsi}
    i1:=i1+1;
    asm
     push ds
     mov si,word ptr ukaz     {offset ukazatele}
     mov ax,si
     add ax,i1
     mov si,ax                {oprava offsetu}
     mov ax, word ptr ukaz+2  {segment}
     mov ds,ax
     mov al,[ds:si]
     pop ds
     mov temp2,al
    end;
    for i2:=1 to (temp1 and 63) do  {vykresleni daneho poctu bodu}
     begin
      Asm
       mov   ax,[where]
       mov   es,ax
       mov   di,VgaPos
       mov   al,Temp2
       mov   byte ptr es:[di],al
      End;
      inc(vgapos);                  {uprava pozice v obrazovce}
     end;
   end
  else
   Begin                               { No compression, plot byte }
    Asm
     mov   ax,[where]
     mov   es,ax
     mov   di,VgaPos
     mov   al,Temp1
     mov   byte ptr es:[di],al
    End;
    Inc(VgaPos);
   End;
 end;
freemem(ukaz,aktivni_data);
end;


procedure  palpcx(jmeno:string);
var i:word;
    f:file;
    colors:array[0..767] of byte;

begin
assign(f,jmeno);
reset(f,1);
seek(f,filesize(f)-768);        {skok na paletu}
BlockRead(F,Colors,768);
for i:=0 to 255 do
 Begin
  activepal[i,1]:=colors[i*3] shr 2;   {jas R,G,B je v rozsahu 0..63}
  activepal[i,2]:=colors[i*3+1] shr 2; {proto to delelni 4}
  activepal[i,3]:=colors[i*3+2] shr 2;
 end;
close(f);
end;


procedure fade;
var a:integer;
begin
 for a:= 0 to 255 do
  begin
   If StorePal[a,1] > ActivePal[a,1] then
    activepal[a,1]:=ActivePal[a,1]+1;
   If StorePal[a,2] > ActivePal[a,2] then
    activepal[a,2]:=ActivePal[a,2]+1;
   If StorePal[a,3] > ActivePal[a,3] then
    activepal[a,3]:=ActivePal[a,3]+1;
  end;
   waitretrace;
   SetPalette;
end;

procedure scrdown;
var krok,x,vgapos:word;
begin
for krok:=0 to 62 do
 begin
 for x:=0 to 1164 do
  begin
   vgapos:=62*x+krok;
   if vgapos>64000 then vgapos:=64000;
   Asm
     mov   ax,$a000
     mov   es,ax
     mov   di,VgaPos
     mov   al,0
     mov   byte ptr es:[di],al
   end;
  detectkeyboard;
 end;
 delay(30);
 end;
end;

procedure flip32(source,dest:Word); assembler;
  { This copies the entire screen at "source" to destination }
asm
  push    ds
  mov     ax, [Dest]
  mov     es, ax
  mov     ax, [Source]
  mov     ds, ax
  xor     si, si
  xor     di, di
  mov     cx, 16000
  db      $F3, $66, $A5
  pop     ds
end;


procedure scrup(from:word);
var krok,x,vgapos:word;
begin
for krok:=62 downto 0 do
 begin
 for x:=0 to 1164 do
  begin
   vgapos:=62*x+krok;
   if vgapos>64000 then vgapos:=64000;
   Asm
     mov   ax,[from]
     mov   es,ax
     mov   di,VgaPos
     xor   ax,ax
     mov   al,byte ptr es:[di]
     push  ax
     mov   ax,$a000
     mov   es,ax
     pop   ax
     mov   byte ptr es:[di],al
   end;
 detectkeyboard;
 end;
 delay(30);
 end;
end;



end.






