home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / plot.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-21  |  3KB  |  104 lines
  1.  
  2. program ScreenSaver1;
  3. { Screen-saver kind of plot-routine, by Bas van Gaalen, Holland, PD }
  4. uses
  5.   crt,dos;
  6.  
  7. const
  8.   F       = 5;
  9.   Dots    = 75;
  10.   SinLen1 = 600;
  11.   SinLen2 = 300;
  12.   SinAmp1 = 49;
  13.   SinAmp2 = 39;
  14.   SinOfs1 = 50;
  15.   SinOfs2 = 50;
  16.   Xstep1  = 2;
  17.   Xstep2  = 3;
  18.   Ystep1  = 3;
  19.   Ystep2  = 2;
  20.   Xspeed1 = 3;
  21.   Xspeed2 = 2;
  22.   Yspeed1 = 2;
  23.   Yspeed2 = 3;
  24.  
  25. var
  26.   SinTab1 : array[0..SinLen1] of byte;
  27.   SinTab2 : array[0..SinLen2] of byte;
  28.  
  29. {----------------------------------------------------------------------------}
  30.  
  31. procedure SetGraphics(Mode : word); assembler; asm
  32.   mov ax,Mode; int 10h end;
  33.  
  34. {----------------------------------------------------------------------------}
  35.  
  36. procedure InitColors;
  37.  
  38. var
  39.   I : byte;
  40.  
  41. begin
  42.   for I := 0 to 63 do begin
  43.     port[$3C8] := I;
  44.     port[$3C9] := I div 3;
  45.     port[$3C9] := I div 2;
  46.     port[$3C9] := I div 2;
  47.   end;
  48. end;
  49.  
  50. {----------------------------------------------------------------------------}
  51.  
  52. procedure CalcSinus;
  53.  
  54. var
  55.   I : word;
  56.  
  57. begin
  58.   for I := 0 to SinLen1 do SinTab1[I] := round(sin(I*(4*pi)/SinLen1)*SinAmp1)+SinOfs1;
  59.   for I := 0 to SinLen2 do SinTab2[I] := round(sin(I*(4*pi)/SinLen2)*SinAmp2)+SinOfs2;
  60. end;
  61.  
  62. {----------------------------------------------------------------------------}
  63.  
  64. procedure Plotter;
  65.  
  66. const
  67.   StartCount = 150;
  68.  
  69. var
  70.   Xst1,Xst2,Yst1,Yst2,I,J,OffSet,OnSet : word;
  71.   K : byte;
  72.  
  73. begin
  74.   randomize;
  75.   Xst1 := 50; Xst2 := 130; Yst1 := 0; Yst2 := 70;
  76.   repeat
  77.     while (port[$3da] and 8) <> 0 do;
  78.     while (port[$3da] and 8) = 0 do;
  79.     for J := 0 to 9 do
  80.       for I := 0 to Dots do begin
  81.         OffSet := ((SinTab1[(Yst1+I*Ystep1) mod SinLen1]+SinTab2[(Yst2+I*Ystep2) mod SinLen2])*320)+
  82.           (SinTab1[(Xst1+I*Xstep1) mod SinLen1])+(SinTab2[(Xst2+I*Xstep2) mod SinLen2])+60;
  83.         OnSet := ((SinTab1[(Yst1+Yspeed1*F*J+I*Ystep1) mod SinLen1]+SinTab2[(Yst2+Yspeed2*F*J+I*Ystep2) mod SinLen2])*320)+
  84.           (SinTab1[(Xst1+Xspeed1*F*J+I*Xstep1) mod SinLen1])+(SinTab2[(Xst2+Xspeed2*F*J+I*Xstep2) mod SinLen2])+60;
  85.         mem[$a000:OffSet] := 0;
  86.         mem[$a000:OnSet] := 18+5*J;
  87.       end;
  88.     Xst1 := (Xst1+Xspeed1) mod SinLen1;
  89.     Xst2 := (Xst2+Xspeed2) mod SinLen2;
  90.     Yst1 := (Yst1+Yspeed1) mod SinLen1;
  91.     Yst2 := (Yst2+Yspeed2) mod SinLen2;
  92.   until keypressed;
  93. end;
  94.  
  95. {----------------------------------------------------------------------------}
  96.  
  97. begin
  98.   SetGraphics($13);
  99.   CalcSinus;
  100.   InitColors;
  101.   Plotter;
  102.   textmode(lastmode);
  103. end.
  104.