home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / plot3.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-22  |  2KB  |  100 lines
  1.  
  2. program _Plotter;
  3. { And another, also needs SVGA-driver, by Bas van Gaalen, Holland, PD }
  4. uses
  5.   crt,dos,graph;
  6.  
  7. {$I SVGA256.INC}
  8.  
  9. const
  10.   F      = 5;
  11.   Dots   = 75;
  12.   SLen1  = 500;
  13.   SLen2  = 650;
  14.   SAmp1  = 150;
  15.   SAmp2  = 75;
  16.   SOfs1  = 150;
  17.   SOfs2  = 110;
  18.   Xstep1 = 2;
  19.   Xstep2 = 3;
  20.   Ystep1 = 3;
  21.   Ystep2 = 2;
  22.   Xspd1  = 3;
  23.   Xspd2  = 4;
  24.   Yspd1  = 2;
  25.   Yspd2  = 4;
  26.  
  27. var
  28.   STab1 : array[0..SLen1] of word;
  29.   STab2 : array[0..SLen2] of word;
  30.  
  31. {----------------------------------------------------------------------------}
  32.  
  33. procedure Setvideo; var GrMd,GrDr : integer;
  34.  
  35. {$F+} function DetectVGA : Integer; begin DetectVGA := 2; end; {$F-}
  36.  
  37. begin
  38.   InstallUserDriver('SVGA256',@DetectVGA); GrDr := Detect;
  39.   InitGraph(GrDr,GrMd,'i:\bgi');
  40. end;
  41.  
  42. {----------------------------------------------------------------------------}
  43.  
  44. procedure InitColors; var I : byte;
  45.  
  46. begin
  47.   for I := 1 to 63 do begin
  48.     port[$3C8] := I;
  49.     port[$3C9] := 32;
  50.     port[$3C9] := I div 2;
  51.     port[$3C9] := I;
  52.   end;
  53. end;
  54.  
  55. {----------------------------------------------------------------------------}
  56.  
  57. procedure CalcSinus; var I : word;
  58.  
  59. begin
  60.   for I := 0 to SLen1 do STab1[I] := round(sin(I*(4*pi)/SLen1)*SAmp1)+SOfs1;
  61.   for I := 0 to SLen2 do STab2[I] := round(sin(I*(4*pi)/SLen2)*SAmp2)+SOfs2;
  62. end;
  63.  
  64. {----------------------------------------------------------------------------}
  65.  
  66. procedure Plotter;
  67.  
  68. var
  69.   Xst1,Xst2,Yst1,Yst2,I,J,Xon,Yon,Xoff,Yoff : word;
  70.  
  71. begin
  72.   randomize;
  73.   Xst1 := 50; Xst2 := 130; Yst1 := 0; Yst2 := 70;
  74.   repeat
  75.     for J := 0 to 7 do
  76.       for I := 0 to Dots do begin
  77.         Yoff := STab1[(Yst1+I*Ystep1) mod SLen1]+STab2[(Yst2+I*Ystep2) mod SLen2];
  78.         Xoff := STab1[(Xst1+I*Xstep1) mod SLen1]+STab2[(Xst2+I*Xstep2) mod SLen2];
  79.         Yon := STab1[(Yst1+Yspd1*F*J+I*Ystep1) mod SLen1]+STab2[(Yst2+Yspd2*F*J+I*Ystep2) mod SLen2];
  80.         Xon := STab1[(Xst1+Xspd1*F*J+I*Xstep1) mod SLen1]+STab2[(Xst2+Xspd2*F*J+I*Xstep2) mod SLen2];
  81.         putpixel(60+Xoff,Yoff,0);
  82.         putpixel(60+Xon,Yon,18+5*J);
  83.       end;
  84.     Xst1 := (Xst1+Xspd1) mod SLen1;
  85.     Xst2 := (Xst2+Xspd2) mod SLen2;
  86.     Yst1 := (Yst1+Yspd1) mod SLen1;
  87.     Yst2 := (Yst2+Yspd2) mod SLen2;
  88.   until keypressed;
  89. end;
  90.  
  91. {----------------------------------------------------------------------------}
  92.  
  93. begin
  94.   Setvideo;
  95.   CalcSinus;
  96.   InitColors;
  97.   Plotter;
  98.   textmode(lastmode);
  99. end.
  100.