program skystuff;


uses crush13h,crt;

Type RgbItem=Record
                   R,G,B:Byte;
             End;
     RgbList=Array[0..255] of RgbItem;

Var  color: array [1..20] of integer;
     temp:rgblist;
     ncolors:integer;

Procedure fadeto (x,y,z:byte;h:integer);
var a:integer;
    r,g,b:byte;
begin
     delay (h);
     for a:=0 to 255 do
     begin
          getcolor (a,r,g,b);
          if r>x then r:=r-1;
          if r<x then r:=r+1;
          if g>y then g:=g-1;
          if g<y then g:=g+1;
          if b>z then b:=b-1;
          if b<z then b:=b+1;
          setcolor (a,r,g,b);
          end;
end;

procedure fadefrom (temp:rgblist;h:integer);
var a:integer;
    r,g,b:byte;
begin
     delay (h);
     for a:=0 to 255 do
     begin
          getcolor (a,r,g,b);
          if r>temp[a].r then r:=r-1;
          if r<temp[a].r then r:=r+1;
          if g>temp[a].g then g:=g-1;
          if g<temp[a].g then g:=g+1;
          if b>temp[a].b then b:=b-1;
          if b<temp[a].b then b:=b+1;
          setcolor (a,r,g,b);
     end;
end;

Procedure palrotation;
var a:integer;
    r,g,b,d,e,f:byte;
begin
     getcolor (color[ncolors],d,e,f);
     for a:=(ncolors-1) downto 1 do
         begin
              getcolor (color[a],r,g,b);
              setcolor (color[a+1],r,g,b);
         end;
     setcolor (color[1],d,e,f);
end;

procedure savepal;
var a:integer;
begin
     for a:=0 to 255 do getcolor (a,temp[a].r,temp[a].g,temp[a].b);
end;

procedure restorepal;
var a:integer;
begin
     for a:=0 to 255 do setcolor (a,temp[a].r,temp[a].g,temp[a].b);
end;

procedure copypage_boom(r,g,b,c:byte);
var a:integer;
begin
     for a:=0 to 63 do fadeto (r,g,b,0);
     restorepal;
     if c=1 then move(mem[vp[1]:0],mem[vga:0],64000);
     if c=2 then move(mem[vp[2]:0],mem[vga:0],64000);
end;

{-----------------------------------------------}

var count,a:integer;
    x,y:word;
    c:char;

procedure interlace_2(from:word;y2:integer;too:word);
var a:integer;
begin
     for a:=y2 to y2+200 do
         begin
              if a>-1 then if a<200 then
               if a mod 2 = 0 then move(mem[from:320*(a-y2)],mem[too:320*a],320);
         end;
end;

procedure interlace_3(from:word;y2:integer;too:word);
var a:integer;
begin
     for a:=y2 to y2+200 do
         begin
              if a>-1 then if a<200 then
               if a mod 2 <> 0 then move(mem[from:320*(a-y2)],mem[too:320*a],320);
         end;
end;




begin
     video_mode ( $13);
     initvirt;

     cls (0,vga);
     cls (0,vp[1]);
     cls (0,vp[2]);
     loadpcx ('c:\ps\neopaint\pcx\cloud.pcx',vp[1]);
     loadfont ('c:\ps\turbo\ps\fonts\heabra.fnt',1);
     setcolor (0,63,63,63);
     savepal;
     setcolor (0,0,0,0);

     move(mem[vp[1]:0],mem[vp[2]:0],64000);

     f_square (0,0,319,70,0,vp[2]);
     f_square (0,70,85,100,0,vp[2]);
     f_square (235,70,319,100,0,vp[2]);

     f_square (0,100,40,130,0,vp[2]);
     f_square (280,100,319,160,0,vp[2]);
     f_square (0,130,319,199,0,vp[2]);
     putstring (85,70,111,30,0,'LABEL',1,vp[2]);
     putstring (40,100,111,30,0,'PRESENTS',1,vp[2]);
     count:=-200;

     for a:=0 to 63 do fadeto (0,0,0,0);
     move (mem[vp[1]:0],mem[vga:0],64000);
     for a:=0 to 63 do fadefrom (temp,63);

     repeat
      count:=count+1;
      if count>200 then count:=-200;
      waitvbl;
      interlace_2 (vp[2],count,vga);
      interlace_3 (vp[2],count *(-1),vga);
      if count>-1 then if count<200 then for x:=0 to 319 do putpixel (x,count,0,vga);
      if count>-200 then if count<0 then for x:=0 to 319 do putpixel (x,count+200,0,vga);
      if count*(-1)>-1 then if count*(-1)<200 then for x:=0 to 319 do putpixel (x,count*(-1),0,vga);
      if count*(-1)>-200 then if count*(-1)<0 then for x:=0 to 319 do putpixel (x,count*(-1)+200,0,vga);

     until count=0;

     for a:=0 to 63 do waitvbl;
     for a:=0 to 63 do fadeto (63,63,63,40);

     move (mem[vp[1]:0],mem[vp[2]:0],64000);
     f_square (0,0,319,85,0,vp[2]);
     f_square (0,85,40,115,0,vp[2]);
     f_square (280,85,319,115,0,vp[2]);
     f_square (0,115,319,199,0,vp[2]);
     putstring (40,85,111,30,0,'SKYSCAPE',1,vp[2]);

     cls (0,vga);
     for a:=0 to 63 do fadefrom (temp,0);

     count:=-200;

     repeat
      count:=count+1;
      if count>200 then count:=-200;
      waitvbl;
      interlace_2 (vp[2],count,vga);
      interlace_3 (vp[2],count *(-1),vga);
      if count>-1 then if count<200 then for x:=0 to 319 do putpixel (x,count,0,vga);
      if count>-200 then if count<0 then for x:=0 to 319 do putpixel (x,count+200,0,vga);
      if count*(-1)>-1 then if count*(-1)<200 then for x:=0 to 319 do putpixel (x,count*(-1),0,vga);
      if count*(-1)>-200 then if count*(-1)<0 then for x:=0 to 319 do putpixel (x,count*(-1)+200,0,vga);

     until count=0;

     for a:=0 to 63 do waitvbl;
     for a:=0 to 63 do fadeto (63,63,63,40);




     closevirt;
     video_mode ( 03);
end.
