{some proc from Asphyxia demo trainers from Denthor }
{$X+}
USES MYGRAPH,
     PCXUNITZ,
     crt;
type
     Virtual = Array [1..64000] of byte;
     virtptr=^virtual;
const vga:word=$a000;
      MAXFRAME=6;

VAR source,dest:PaletteTYPE;
    VirScr : VirtPtr;                    { ukazatel virtualni obrazovka}
    Vaddr : Word;                        { segment ukazatele}
    VirScr2 : VirtPtr;                    { ukazatel virtualni obrazovka}
    Vaddr2 : Word;                        { segment ukazatele}
    dir:boolean;                          { smer fade }
    loop1:integer;
    vpisaddr:word;
{컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴}

Procedure SetUpVirtual;                 {Prideli pamet a segment}
BEGIN
  GetMem (VirScr,64000);
  vaddr := seg (virscr^);
  GetMem (VirScr2,64000);             {druha obrazovka seg vaadr2}
  vaddr2 := seg (virscr2^);
  fillchar (source,sizeof(source),0); {nuluje zdroj a dest paletu}
  fillchar (dest,sizeof(dest),0);
END;

Procedure ShutDown;
BEGIN
  FreeMem (VirScr2,64000);
  FreeMem (VirScr,64000);
END;

procedure detectkeyboard;
begin
 if port[$60]=$01 then
   begin
    setvideo(3);
    shutdown;
    halt(0);
  end;
end;


{컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴}
Procedure SetItUp;
VAR loop1,loop2,loop3:integer;
    pal1,pal2:palettetype;
    change:boolean;
    where:integer;
    r,g,b,r1,g1,b1:byte;
BEGIN
  cls32(vaddr2,0);

  For loop1:=0 to 255 do
   setpal (loop1,0,0,0);         {nastavy vsechny barvy na cerou, aby nebylo
                                  nic videt }

  pcxvirt('dest.pcx',vaddr);   {nahraj cil}
  palpcx ('dest.pcx');        {paleta cile pal2}
  pal2:=activepal;

  flip (vaddr,$a000);             {zobrazi cil ???}
  pcxvirt('source.pcx',vaddr);  {nahraj zdroj}
  palpcx ('source.pcx');
  pal1:=activepal;
  where:=0;

  For loop1:=0 to 319 do
    for loop2:=0 to 199 do
    BEGIN
      if (getpixel(loop1,loop2,vaddr)<>0) or (getpixel (loop1,loop2,$a000)<>0) then
      BEGIN
        change:=false;
        r:=pal1[getpixel(loop1,loop2,vaddr),1]; {rgb pal1 pro from}
        g:=pal1[getpixel(loop1,loop2,vaddr),2];
        b:=pal1[getpixel(loop1,loop2,vaddr),3];
        r1:=pal2[getpixel(loop1,loop2,vga),1];   {r1g1b1 pro to}
        g1:=pal2[getpixel(loop1,loop2,vga),2];
        b1:=pal2[getpixel(loop1,loop2,vga),3];

        for loop3:=0 to where do
          if (source[loop3,1]=r) and (source[loop3,2]=g) and (source[loop3,3]=b) and
             (dest[loop3,1]=r1) and (dest[loop3,2]=g1) and (dest[loop3,3]=b1) then
             BEGIN
              virtputpixel(loop1,loop2,loop3,vaddr2);
              change:=TRUE;
             END;
          {podivame se, jestli uz nactena kombinace barev byla nekdy pouzita,
           jestli jo, tak jen vyhodime bod v teto barve do screenu 3}


        if not (change) then    {nactena kombinace nebyla pouzita}
         BEGIN                  {proto ji nastavime jako barvu where}
          inc (where);          {s rgb v source a r1g1b1 v dest}
          if where=256 then
           BEGIN
            setvideo(3);
            writeln ('Obrazek ma moc barev! Redukuj!');
            Halt;
           END;

          virtputpixel(loop1,loop2,where,vaddr2);
          source[where,1]:=r;
          source[where,2]:=g;
          source[where,3]:=b;
          dest[where,1]:=r1;
          dest[where,2]:=g1;
          dest[where,3]:=b1;
          detectkeyboard;
            { Create a new color and set it's from and to pallette values }


        END;
      END;
    END;
  cls32 (vga,0);
END;

{컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴}
Procedure Crossfade (direction:boolean;del,farin:word);
     {del je pomlka a dir smer}
VAR loop1,loop2:integer;
    temp:palettetype;
BEGIN
  if direction then
  BEGIN      {smer source dest}
    temp:=source;
    for loop1:=0 to 255 do
      setpal(loop1,source[loop1,1],source[loop1,2],source[loop1,3]); { setpal source}
    flip (vaddr2,vga);                  {source na screen}
    For loop1:=0 to farin do            {citac zmen}
    BEGIN
      waitretrace;
      detectkeyboard;
      for loop2:=0 to 255 do
        setpal(loop2,temp[loop2,1],temp[loop2,2],temp[loop2,3]);  {setpal temp}
      for loop2:=0 to 255 do
      BEGIN
        if temp[loop2,1]<dest[loop2,1] then inc (temp[loop2,1]);
        if temp[loop2,1]>dest[loop2,1] then dec (temp[loop2,1]);
        if temp[loop2,2]<dest[loop2,2] then inc (temp[loop2,2]);
        if temp[loop2,2]>dest[loop2,2] then dec (temp[loop2,2]);
        if temp[loop2,3]<dest[loop2,3] then inc (temp[loop2,3]);
        if temp[loop2,3]>dest[loop2,3] then dec (temp[loop2,3]);
          {paleta temp se posune  o jednu zmanu k dest}

      END;
      delay (del);
    END;
  END
  else
  BEGIN
    temp:=dest;         {opacnej smer}
    for loop1:=0 to 255 do
      setpal (loop1,dest[loop1,1],dest[loop1,2],dest[loop1,3]);
    flip (vaddr2,vga);
    For loop1:=0 to farin do BEGIN
      waitretrace;
      detectkeyboard;
      for loop2:=0 to 255 do
       setpal(loop2,temp[loop2,1],temp[loop2,2],temp[loop2,3]); {setpal temp}
      for loop2:=0 to 255 do BEGIN
        if temp[loop2,1]<source[loop2,1] then inc (temp[loop2,1]);
        if temp[loop2,1]>source[loop2,1] then dec (temp[loop2,1]);
        if temp[loop2,2]<source[loop2,2] then inc (temp[loop2,2]);
        if temp[loop2,2]>source[loop2,2] then dec (temp[loop2,2]);
        if temp[loop2,3]<source[loop2,3] then inc (temp[loop2,3]);
        if temp[loop2,3]>source[loop2,3] then dec (temp[loop2,3]);
          { temp o jednu zmenu k source }
      END;
      delay (del);
    END;
  END
END;

procedure nejakepismo(x,y,x1,y1,x2,y2,where:word;color:byte);
var a,b:word;
begin
for a:= x1 to x2 do
 for b:=y1 to y2 do
  begin
   if mem[vpisaddr:a+320*b]=0 then virtputpixel(x+a,y+b,color,where);
  end;
end;






BEGIN
  setupvirtual;                          {alokuje virt screen seg vaddr}
  setmode;                              {zapne grafiku}
  SetItUp;                               {alokace tretiho screenu a palet}
  nullpalette;
  setpalette;
  storepal:=source;
  flip (vaddr2,vga);        {source na screen  protoze v setitup tam bylo dest}
  fadein(20);
  detectkeyboard;
  delay (3000);
  detectkeyboard;


  pcxvirt('pismo2.pcx',vaddr);
  vpisaddr:=vaddr;
  nejakepismo(0,0,0,0,319,199,vga,50);
  detectkeyboard;
  delay(3000);
  detectkeyboard;
  dir:=TRUE;                 {smer source, dest}
  crossfade(dir,20,63);      {smer,delay,maximalni pocet zmen(rozsah 0-63 pro r,g,b}

  pcxvirt('pismo3.pcx',vaddr);
  vpisaddr:=vaddr;
  nejakepismo(0,0,0,0,319,199,vga,60);

  detectkeyboard;
  DELAY(3000);
  detectkeyboard;

  for i:=1 to maxframe do
   begin
    dir:=not (dir);            {opacnej smer crossfade}
    detectkeyboard;
    crossfade(dir,20,63);      {smer,delay,maximalni pocet zmen(rozsah 0-63 pro r,g,b}
    delay (500);
   end;
  getpalette;
  fadeinout(5,5);
  setvideo(3);
  shutdown
END.