home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / GFXFX2.ZIP / COPPER4.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-14  |  2KB  |  86 lines
  1.  
  2. program copper; { COPPER4.PAS }
  3. { Multiple copper, by Bas van Gaalen }
  4. uses crt,u_vga,u_kb;
  5. const size=350; step=25;
  6. var
  7.   pal1,pal2:array[0..3*size-1] of byte;
  8.   stab:array[0..255] of word;
  9.   bartab:array[0..2] of word;
  10.  
  11. procedure createtab; var i:byte; begin
  12.   for i:=0 to 255 do stab[i]:=round(sin(2*pi*i/255)*100)+100; end;
  13.  
  14. procedure makecopperlist;
  15. var cc,i:word;
  16. begin
  17.   cc:=0;
  18.   fillchar(pal2,sizeof(pal2),0);
  19.   for i:=0 to size-1 do begin
  20.     pal2[cc+0]:=32+trunc(31*sin(i*pi/(size/2)));
  21.     pal2[cc+1]:=32+trunc(31*sin(i*pi*2/(size/2)));
  22.     pal2[cc+2]:=32+trunc(31*sin(i*pi*3/(size/2)));
  23.     inc(cc,3);
  24.   end;
  25. end;
  26.  
  27. procedure writetext;
  28. var f:text; s:string; i:byte;
  29. begin
  30.   textcolor(1); i:=0;
  31.   assign(f,'copper4.pas');
  32.   {$i-} reset(f); {$i+}
  33.   if ioresult=0 then begin
  34.     while (not eof(f)) and (i<49) do begin
  35.       readln(f,s);
  36.       writeln(s);
  37.       inc(i);
  38.     end;
  39.   end
  40.   else for i:=1 to 49 do writeln('test line ',i);
  41. end;
  42.  
  43. procedure movebars;
  44. var n,i:word;
  45. begin
  46.   fillchar(pal1,sizeof(pal1),0);
  47.   for n:=0 to 2 do begin
  48.     for i:=0 to 63 do pal1[n mod 3+3*stab[bartab[n]]+3*i]:=i;
  49.     for i:=0 to 63 do pal1[n mod 3+3*stab[bartab[n]]+3*64+3*i]:=63-i;
  50.     bartab[n]:=1+bartab[n] mod 255;
  51.   end;
  52. end;
  53.  
  54. procedure copperbars;
  55. var cc,l,j:word;
  56. begin
  57.   asm cli end;
  58.   vretrace;
  59.   cc:=0;
  60.   for l:=0 to size-1 do begin
  61.     while (port[$3da] and 1)<>0 do;
  62.     while (port[$3da] and 1)=0 do;
  63.     port[$3c8]:=0;
  64.     port[$3c9]:=pal1[cc]; port[$3c9]:=pal1[cc+1];
  65.     port[$3c9]:=pal1[cc+2];
  66.     port[$3c8]:=1;
  67.     port[$3c9]:=pal2[cc]; port[$3c9]:=pal2[cc+1]; port[$3c9]:=pal2[cc+2];
  68.     inc(cc,3);
  69.   end;
  70.   asm sti end;
  71. end;
  72.  
  73. var i:byte;
  74. begin
  75.   setvideo(259);
  76.   makecopperlist;
  77.   createtab;
  78.   for i:=0 to 2 do bartab[i]:=step*i;
  79.   writetext;
  80.   repeat
  81.     movebars;
  82.     copperbars;
  83.   until keypressed;
  84.   setvideo(u_lm);
  85. end.
  86.