home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / copper3.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-20  |  996b  |  38 lines
  1.  
  2. program copper;
  3. { Pascal-version of copper-stuff (3), by Bas van Gaalen, Holland, PD }
  4. uses crt;
  5. const
  6.  pal : array [0..3*28-1] of byte =
  7.    (4,4,2,8,8,4,12,12,6,16,16,8,20,20,10,24,24,12,28,28,14,32,32,16,
  8.     36,36,18,40,40,20,44,44,22,48,48,24,52,52,26,52,52,26,56,56,28,
  9.     56,56,28,60,60,30,60,60,30,60,60,30,63,63,33,63,63,33,63,63,33,
  10.     63,63,33,63,63,33,60,60,30,56,56,28,52,52,26,48,48,24);
  11.  
  12. procedure copperbars;
  13. var l:word; lo,lc,cc:byte;
  14. begin
  15.   asm cli end;
  16.   l:=380;
  17.   while (port[$3da] and 8) <> 0 do;
  18.   while (port[$3da] and 8) = 0 do;
  19.   lo:=1;
  20.   while l<>0 do begin
  21.     lc:=lo; inc(lo); cc:=0;
  22.     while (lc<>0) and (l<>0) do begin
  23.       port[$3c8]:=0;
  24.       port[$3c9]:=pal[cc];
  25.       port[$3c9]:=pal[cc+1];
  26.       while (port[$3da] and 1) <> 0 do;
  27.       while (port[$3da] and 1) = 0 do;
  28.       port[$3c9]:=pal[cc+2];
  29.       inc(cc,3); dec(lc); dec(l);
  30.     end;
  31.   end;
  32.   asm sti end;
  33. end;
  34.  
  35. begin
  36.   repeat copperbars; until keypressed;
  37. end.
  38.