home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 300-399 / ff339.lzh / PCQ / Examples / Snow.p < prev    next >
Text File  |  1990-03-19  |  4KB  |  182 lines
  1. Program Snowflake;
  2.  
  3. { This program draws a fractal snowflake pattern.  I think I got it out
  4. of some magazine years ago.  It was written, as I remember it, for the
  5. PC in BASIC, which I converted to AmigaBASIC.  I have long since
  6. forgotten the details of how it worked, so I could not give the
  7. variables meaningful names.  To the original author, by the way, goes
  8. the credit for those names.  Invoke the program with the line "Snow
  9. <level>", where <level> is a digit between 1 and 6.  In order to get a
  10. feel for what's going on, try running the levels in order.  Level 6
  11. takes a long time, and frankly doesn't look as good as level 5.  }
  12.  
  13. {$I ":Include/Ports.i" for GetMsg and WaitPort }
  14. {$I ":Include/Intuition.i" for the windows }
  15. {$I ":Include/Graphics.i" for move() and draw() }
  16. {$I ":Include/Exec.i" just for OpenLibrary and CloseLibrary }
  17.  
  18. var
  19.     dx : array [0..11] of real;
  20.     dy : array [0..11] of real;
  21.     sd : array [0..6] of integer;
  22.     rd : array [0..6] of integer;
  23.     sn : array [0..6] of integer;
  24.     ln : array [0..6] of real;
  25.     a  : real;
  26.     nc : integer;
  27.     x, y, t : real;
  28.     w  : WindowPtr;
  29.     rp : RastPortPtr;
  30.     n  : integer;
  31.     d, ns, i, j : integer;
  32.     l : real;
  33.     m : MessagePtr;
  34.  
  35. Procedure usage;
  36. begin
  37.     writeln('Usage: Snow <level>');
  38.     writeln('       where <level> is between 1 and 6');
  39.     exit(20);
  40. end;
  41.  
  42. Function readcycles(): integer;
  43. var
  44.     index : integer;
  45.     cycles : integer;
  46. begin
  47.     index := 0;
  48.     while ((commandline[index] = ' ') or (commandline[index] = chr(9))) and
  49.     (index < 128) do
  50.     index := index + 1;
  51.     if index >= 128 then
  52.     usage;
  53.     cycles := ord(commandline[index]) - ord('0');
  54.     if (cycles > 6) or (cycles < 1) then
  55.     usage;
  56.     readcycles := cycles;
  57. end;
  58.  
  59. Function OpenTheWindow() : Boolean;
  60. var
  61.     nw : NewWindowPtr;
  62. begin
  63.     new(nw);
  64.  
  65.     nw^.LeftEdge := 0;
  66.     nw^.TopEdge := 0;
  67.     nw^.Width := 640;
  68.     nw^.Height := 200;
  69.  
  70.     nw^.DetailPen := -1;
  71.     nw^.BlockPen  := -1;
  72.     nw^.IDCMPFlags := CLOSEWINDOW_f;
  73.     nw^.Flags := WINDOWDEPTH_f + WINDOWCLOSE_f + SMART_REFRESH_f + ACTIVATE_f;
  74.     nw^.FirstGadget := nil;
  75.     nw^.CheckMark := nil;
  76.     nw^.Title := "Fractal Snowflake";
  77.     nw^.Screen := nil;
  78.     nw^.BitMap := nil;
  79.     nw^.MinWidth := 50;
  80.     nw^.MaxWidth := -1;
  81.     nw^.MinHeight := 20;
  82.     nw^.MaxHeight := -1;
  83.     nw^.WType := WBENCHSCREEN_f;
  84.  
  85.     w := OpenWindow(nw);
  86.     dispose(nw);
  87.     OpenTheWindow := w <> nil;
  88. end;
  89.  
  90. procedure initarrays;
  91. begin
  92.     sd[0] := 0;
  93.     rd[0] := 0;
  94.     sd[1] := 1;
  95.     rd[1] := 0;
  96.     sd[2] := 1;
  97.     rd[2] := 7;
  98.     sd[3] := 0;
  99.     rd[3] := 10;
  100.     sd[4] := 0;
  101.     rd[4] := 0;
  102.     sd[5] := 0;
  103.     rd[5] := 2;
  104.     sd[6] := 1;
  105.     rd[6] := 2;
  106.  
  107.     for n := 0 to 6 do
  108.     ln[n] := 1.0 / 3.0;
  109.     ln[2] := sqrt(ln[1]);
  110.     a := 0.0;
  111.     for n := 6 to 11 do begin
  112.     dy[n] := sin(a);
  113.     dx[n] := cos(a);
  114.         a := a + 0.52359;
  115.     end;
  116.     for n := 0 to 5 do begin
  117.     dx[n] := -(dx[n + 6]);
  118.     dy[n] := -(dy[n + 6]);
  119.     end;
  120.     x := 534.0;
  121.     y := 151.0;
  122.     t := 324.0;
  123. end;
  124.  
  125. begin
  126.     nc := readcycles();
  127.     initarrays;
  128.  
  129.     GfxBase := OpenLibrary("graphics.library", 0);
  130.     if GfxBase = nil then begin
  131.     writeln('Could not open Graphics.library');
  132.     exit(20);
  133.     end;
  134.  
  135.     if OpenTheWindow() then begin
  136.     rp := w^.RPort;
  137.  
  138.     for n := 0 to nc do
  139.         sn[n] := 0;
  140.  
  141.     Move(rp, trunc(x), trunc(y));
  142.  
  143.     repeat
  144.         d := 0;
  145.         l := t;
  146.         ns := 0;
  147.  
  148.         for n := 1 to nc do begin
  149.         i := sn[n];
  150.         l := l * ln[i];
  151.         j := sn[n - 1];
  152.         ns := ns + sd[j];
  153.         if odd(ns) then
  154.             d := (d + 12 - rd[i]) mod 12
  155.         else
  156.             d := (d + rd[i]) mod 12;
  157.         end;
  158.  
  159.         x := x + 1.33 * l * dx[d];
  160.         y := y - 0.5 * l * dy[d];
  161.  
  162.         Draw(rp, trunc(x), trunc(y));
  163.         sn[nc] := sn[nc] + 1;
  164.         n := nc;
  165.         while (n >= 1) and (sn[n] = 7) do begin
  166.         sn[n] := 0;
  167.         sn[n - 1] := sn[n - 1] + 1;
  168.         n := n - 1;
  169.         end;
  170.     until sn[0] <> 0;
  171.     m := WaitPort(w^.UserPort);
  172.     forbid;
  173.     repeat
  174.         m := GetMsg(w^.UserPort);
  175.     until m = nil;
  176.     permit;
  177.     CloseWindow(w);
  178.     end else
  179.     writeln('Could not open the window');
  180.     CloseLibrary(GfxBase);
  181. end.
  182.