home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / GLOB.ZIP / GLOB.PAS
Encoding:
Pascal/Delphi Source File  |  1986-04-05  |  1.8 KB  |  73 lines
  1. Program PlotAGlobularCluster (input,Output);
  2.   Label
  3.     Line48;
  4.   Var
  5.     S1,R,R0,R1,R2,R3,C,C0,C1,D,A,P1,X,Y,X2,Y2,Z : Real;
  6.     T,Xm,Ym,XPlot,YPlot,I,K,S : Integer;
  7.  
  8.   Procedure Sub100; { Newton-Raphson Iteration }
  9.     Begin { Procedure Sub100 }
  10.       A := R/R0;
  11.       C1 := ArcTan(A)*0.5*R3;
  12.       A := 1+A*A;
  13.       C1 := C1+R*0.5*R2/A;
  14.       C1 := PI*(C1-R*R2/(A*A));
  15.       D := 4*PI*R*R/(A*A*A);
  16.     End; { Procedure Sub100 }
  17.  
  18.   Procedure Sub200; { 2-Dimensional Plot }
  19.     Label
  20.       Line225;
  21.     Begin { Procedure Sub200 }
  22.       XPlot := Round(X*S+X2);
  23.       YPlot := Round(Y*S+Y2);
  24.       If (XPlot < 0) Or (YPlot < 0) Then
  25.         Goto Line225;
  26.       If (XPlot > Xm) Or (YPlot > Ym) Then
  27.         Goto Line225;
  28.       Plot(XPlot,YPlot,2);
  29.       Line225:
  30.     End; { Procedure Sub200 }
  31.  
  32.   Begin { Program }
  33.     R0 := 20;
  34.     R2 := R0*R0;
  35.     R3 := R2*R0;
  36.     C0 := PI*PI*R3/4;
  37.     R1 := R0/Sqrt(2);
  38.     Xm := 320;
  39.     Ym := 200;
  40.     X2 := Xm/2;
  41.     Y2 := Ym/2;
  42.     S := 5;
  43.     Write('How many stars? ');
  44.     Readln(T);
  45.     GraphMode;
  46.     Palette(0);
  47.     For I := 1 To T Do
  48.       Begin { For I }
  49.         C := C0*Random;
  50.         R := R1;
  51.         For K := 1 To 5 Do
  52.           Begin { For K }
  53.             Sub100;
  54.             R := R+(C-C1)/D;
  55.           End; { For K }
  56.         Line48:
  57.         X := Random - 0.5;
  58.         Y := Random - 0.5;
  59.         Z := Random - 0.5;
  60.         S1 := Sqrt(X*X+Y*Y+Z*Z);
  61.         If S1 > 1 Then
  62.           Goto Line48;
  63.         R := R*S1;
  64.         X := X*R;
  65.         Y := Y*R;
  66.         Z := Z*R;
  67.         Sub200;
  68.       End; { For I }
  69.       Write(^G);
  70.       Repeat Until Keypressed;
  71.       TextMode;
  72.     End. { Program }
  73.