home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / pasgraph / spiral.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-12  |  2KB  |  61 lines
  1. {
  2.   I was going to use Modex, but I couldn't find any way to draw a line from
  3. point x to point y, and save the point with a putpixel etc, so I just
  4. used BGI (plus I didn't want to take too much time on an Apple Basic program
  5. that may or may not work!
  6.  
  7.   Okay, what is this? It's is a hexagon that is repeated, but put off on a
  8. spiral, it produces quite a cool effect, and I through in a couple ways to
  9. speed it up, I'm using all reals just for simplicity not for speed.
  10.  
  11. I don't know if any one has ever posted something like this, but here goes.
  12. Converted to Pascal v7.0 from Apple BASIC by John Stephenson Mon 8/8/94
  13. }
  14.  
  15. uses graph, crt;
  16. var
  17.   cs, co, sn, si, cx, cy, x, y, ad, sf, xo: real;
  18.   j, i: byte;
  19.   grDriver, grMode: Integer;
  20.   xp, yp, color: word;
  21. begin
  22.   grDriver := Detect;
  23.   InitGraph(grDriver, grMode, 'C:\TP\BGI');
  24.   if GraphResult <> grOk then begin
  25.     writeln('It would be a good idea to configure the line with Initgraph on it!');
  26.     readln;
  27.     halt(1);
  28.   end;
  29.  
  30.   cs := Cos(pi / 3);
  31.   co := Cos(pi / 36);
  32.   sn := Sin(pi / 3);
  33.   si := Sin(pi / 36);
  34.   cx := 140;
  35.   cy := 96;
  36.   ad := 1.16;
  37.   sf := 1.06;
  38.   color := 1;
  39.   repeat
  40.     x := 12;
  41.     y := 0;
  42.     setcolor(color);
  43.     inc(color);
  44.     For j := 0 to 70 do begin
  45.       For i := 0 to 6 do begin
  46.         xp := trunc(cx + x * ad);
  47.         yp := trunc(cy + y);
  48.         If (i = 0) Then PutPixel(xp, yp, color);
  49.         lineto(xp, yp);
  50.         xo := x * cs - y * sn;
  51.         y := x * sn + y * cs;
  52.         x := xo;
  53.       End;
  54.       xo := sf * (x * co - y * si);
  55.       y := sf * (x * si + y * co);
  56.       x := xo;
  57.     End;
  58.   until keypressed;
  59.   CloseGraph;
  60. End.
  61.