program subliminar;

uses crush13h,crt;

Type RgbItem=Record
                   R,G,B:Byte;
             End;
     RgbList=Array[0..255] of RgbItem;
Var  color1: array [1..10] of integer;
     color2: array [1..10] of integer;
     temp:   rgblist;
     a:integer;
     ncolors:integer;
     c:char;

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

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

begin
     video_mode ( $13);
     initvirt;
     loadfont ('..\fonts\5x5caps.fnt',1);
     cls (166,vga);

     for a:=1 to 19 do putstring (50,a*10,0,5,1,'Subliminar contents is everywhere!',1,vga);

     ncolors:=6;
     for a:=1 to 6 do
         begin
              color1[a]:=164+a;
         end;
     setcolor (165,53,0,60);
     setcolor (166,2,23,11);
     setcolor (167,3,34,54);
     setcolor (168,19,5,63);
     setcolor (169,20,0,6);
     setcolor (170,2,63,34);

     for a:=1 to 6 do
         begin
              color2[a]:=143+a;
         end;
     setcolor (144,53,20,60);
     setcolor (145,2,23,11);
     setcolor (146,3,34,54);
     setcolor (147,19,5,63);
     setcolor (148,20,0,6);
     setcolor (149,2,63,34);


     repeat

           palrotation1;
           waitvbl;
           palrotation2;

           if keypressed=true then c:=readkey;
     until c=#27;

     closevirt;
     video_mode ( 03);
end.