home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SLOGRO.ZIP / SLOGRO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-11-26  |  4.2 KB  |  195 lines
  1. Program Slogplot;
  2. Uses Crt,Graph,Dos,Printer;
  3.  
  4. Const    Convert    =    (3.1415926536*2)/360 ;
  5.  
  6. Var    Particles    :    LongInt;
  7.     Held        :    Integer;
  8.     Old_Held    :    Integer;
  9.     Textline    :    String;
  10.     Blanker    :    Pointer;
  11.     Time_Start    :    LongInt;
  12.     Time_Last   :    LongInt;
  13.     Time_Work    :    LongInt;
  14.     Time_Total    :    LongInt;
  15.     Old_Hour    :    Integer;
  16.     MaxX        :    Integer;
  17.     MaxY        :    Integer;
  18.       Plotter     :     Char;
  19.  
  20. Function secs : LongInt;
  21. Var Hour,Min,Sec,Sec100 : Word;
  22.     Work    : Longint;
  23. Begin
  24.     Gettime( Hour, Min , Sec , Sec100 );
  25.     If ( Old_Hour = -1 ) then Old_Hour := Hour ;
  26.     If ( Hour < Old_Hour ) Then Hour := Hour + 24 ;
  27.  
  28.     Work := Hour * 60 * 60 + Min * 60 + sec ;
  29.     secs := Work;
  30. End;
  31.  
  32. Procedure Start_graphics;
  33. Var    Graphmode , Graphdriver : integer;
  34.     Error                : Boolean;
  35. Begin
  36.      Graphdriver := detect;
  37.      Graphmode := 0;
  38.  
  39.      Initgraph( Graphdriver , Graphmode , '' );
  40.      Error := ( Graphresult <> 0 );
  41.      If (Error) then Halt(1);
  42.      MaxX := GetMaxX;
  43.      MaxY := GetMaxY;
  44. end;
  45.  
  46. Procedure End_graphics;
  47. Begin
  48.      Closegraph;
  49. End;
  50.  
  51. Procedure Init_Plotter;
  52. Begin
  53.     Writeln(Lst,'RE;');
  54.     Writeln(Lst,'HO;');
  55. End;
  56.  
  57. Procedure Plot_Line(X1,Y1,X2,Y2:Word);
  58. Var    Plotline    :    String;
  59.     Work        :    String;
  60. Begin
  61.     Plotline := 'LN ';
  62.     Str(X1,Work);
  63.     Plotline := Plotline + Work + ',';
  64.     Str(Y1,Work);
  65.     Plotline := Plotline + Work + ',';
  66.     Str(X2,Work);
  67.     Plotline := Plotline + Work + ',';
  68.     Str(Y2,Work);
  69.     Plotline := Plotline + Work + ';';
  70.     Writeln(lst,Plotline);
  71. End;
  72.  
  73. (* Draw a box in the are of (-100,-100) - (100,100) *)
  74. Procedure Plot_Point(X,Y:Integer);
  75. Var    X1,Y1,X2,Y2    :    Word;
  76. Begin
  77.     X := X * 9 + 1250 ;
  78.     Y := Y * 9 + 919 ;
  79.  
  80.     X1 := X - 4 ;
  81.     X2 := X + 4 ;
  82.     Y1 := Y - 4 ;
  83.     Y2 := Y + 4 ;
  84.     Plot_Line(X1,Y1,X2,Y1);
  85.     Plot_Line(X2,Y1,X2,Y2);
  86.     Plot_Line(X2,Y2,X1,Y2);
  87.     Plot_Line(X1,Y2,X1,Y1);
  88. End;
  89.  
  90. Procedure Do_Particle;
  91. Var    X,Y    :    Integer;
  92.     X1,Y1    :    Integer;
  93.     Angle    :     Real;
  94.     Done    :    Word;
  95. Begin
  96.     Angle := Random(360);
  97.       Angle := Angle*Convert;
  98.     X := Trunc(Sin(Angle)*100);
  99.     Y := Trunc(Cos(Angle)*100);
  100.     X1 := X + 150 ;
  101.     Y1 := Y + 150 ;
  102.     done := 0 ;
  103.     While  (     (GetPixel(X1-1,Y1-1)=0)
  104.            and (GetPixel(X1,Y1-1)=0)
  105.            and (GetPixel(X1+1,Y1-1)=0)
  106.            and (GetPixel(X1-1,Y1)=0)
  107.            and (GetPixel(X1+1,Y1)=0)
  108.            and (GetPixel(X1-1,Y1+1)=0)
  109.            and (GetPixel(X1,Y1+1)=0)
  110.            and (GetPixel(X1+1,Y1+1)=0)
  111.            and ( done = 0 )) do
  112.     Begin
  113.         PutPixel(X1,Y1,0);
  114.         Case Random(4) of
  115.             0 :    X := X + 1 ;
  116.             1 :    Y := Y + 1 ;
  117.             2 :    X := X - 1 ;
  118.             3 :    Y := Y - 1 ;
  119.         End;
  120.             X1 := X + 150 ;
  121.           Y1 := Y + 150 ;
  122.         If (Sqr(X)+Sqr(Y)>10000) then done := 1
  123.         else PutPixel(X1,Y1,1);
  124.     End;
  125.     If (done=0) then
  126.     Begin
  127.         Held := Held + 1 ;
  128.         If Plotter='Y' then
  129.             Plot_Point(X,Y);
  130.     End;
  131.     Particles := Particles + 1;
  132. End;
  133.  
  134. Procedure InfoLine;
  135. Begin
  136.     Moveto(0,0);
  137.     PutImage(0,0,Blanker^,CopyPut);
  138.     OutText('Part:');
  139.     Str((Particles+1):6,Textline);
  140.     OutText(Textline);
  141.       OutText('  Held:');
  142.       Str(Held:6,Textline);
  143.       OutText(Textline);
  144.     OutText('  Time:');
  145.     Str((Time_Work-Time_Last):6,TextLine);
  146.     OutText(TextLine);
  147.     OutText('  Average Time:');
  148.     If (Held = 0 ) then
  149.         Textline := '    0.00'
  150.     else
  151.         Str(((Time_Work-Time_Start) / Held) :7:2,TextLine);
  152.     OutText(TextLine);
  153.     OutText('  Total Time:');
  154.     Str((Time_Work-Time_Start):8,TextLine);
  155.     OutText(TextLine);
  156. End;
  157.  
  158. Begin
  159.     ClrScr;
  160.     Writeln('                       Slo-Gro Fractal Generator');
  161.     Writeln('                           -+- Devin Cook -+-');
  162.     Writeln;
  163.     Plotter := ' ';
  164.     While(NOT(Plotter In ['Y','N'])) do
  165.     Begin
  166.         Write('Plotter (Y/N)');
  167.         Readln(Plotter);
  168.         If Plotter='y' then Plotter := 'Y';
  169.         If Plotter='n' then Plotter := 'N';
  170.     End;
  171.     If Plotter = 'Y' then Init_Plotter;
  172.     Randomize;
  173.     Old_Hour := -1 ;
  174.     NoSound;
  175.     Start_Graphics;
  176.     GetMem( Blanker , ImageSize(0,0,MaxX,8));
  177.     GetImage( 0,0,MaxX,8,Blanker^);
  178.     PutPixel(150,150,1);
  179.     If (Plotter='Y') then Plot_Point(0,0);
  180.     Particles := 0 ;
  181.     Held := 0 ;
  182.       Old_Held := - 1;
  183.     Time_Start := secs;
  184.     Time_Last := Time_Start;
  185.     Time_Work := Time_Last;
  186.     Time_Total := 0 ;
  187.     Repeat
  188.         If (Held<>Old_Held) then InfoLine;
  189.             Old_Held := Held;
  190.         Time_Last := Time_Work;
  191.         Do_Particle;
  192.         Time_Work := secs;
  193.     until (Keypressed);
  194.     End_Graphics;
  195. End.