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