Информационный сервер для программистов: Исходники со всего света. Паскальные исходники со всего света
  Powered by Поисковый сервер Яndex: Найдется ВСЁ!
На Главную Pascal Форум Информер Страны мира
   Demo Making    >>    fractal
   
 
 Filled Fractal Routines   Sacha Chua 24.07.97

Демонстрация шести вариантов фрактальных структур, из них одна - динамическая. BGI Graphics. [640x480x16]
Draws some fractals, some classics and some new ones you've maybe never seen.



6k 
 

{> Cut here. FileName= FRACTAL.PAS } { Signed by Sacha Chua, sacha@i-manila.com.ph http://www.geocities.com/SouthBeach/6562/ This program was written on March 23, 1997 in Turbo Pascal Copyright (c) 1997 Sacha Chua. } program fractals; { This program contains fractal routines. } uses crt, graph; const maxpoly = 20; type polypoints = array[1..maxpoly + 1] of pointtype; procedure makepoly( var P: polypoints; { Returned polygon vertices } X, Y, { Coordinates of center of polygon } N, { Number of sides of polygon } Size, { Height/width of polygon } Rotation : integer);{ Angle of rotation } forward; { This procedure returns a polygon of the type used by DrawPoly and FillPoly. Because it uses trigonometric functions to determine the coordinates of the vertices, it may not be as nice (straight lines and all).} procedure poly_fractal( X, Y, { Coordinates of center of fractal } N, { Number of sides of fractal } Size : integer; { Height/width of fractal } R : byte; { Depth/detail of fractal } Hollow : boolean); { Do not fill in the fractal } forward; { This procedure draws a normal fractal. } procedure rotated_poly_fractal( X, Y, { Coordinates of center } N, { Number of sides } Size : integer; { Height/Width of fractal } R : byte; { Depth/detail of fractal } Hollow : boolean; { Do not fill in the fractal } Angle : integer { Rotation angle } ); forward; procedure rect_fractal (x, y, size : integer; r : byte); forward; { Primitive fractal for squares } procedure tri_fractal2 (x, y, size : integer; r : byte); forward; { Fractal found in Pascal's Triangle } procedure bintree_fractal (x, y, size : integer; r : byte); forward; { Binary tree fractal } { !------------------ POLYGON HANDLING ------------------------- } procedure makepoly(var p: polypoints; x, y, n, size, rotation : integer); { n is the number of sides, size the total width/height } var ctr : byte; a : real; begin a := (360 / n + rotation) * (pi / 180); if n <> 4 then for ctr := 1 to n do begin p[ctr].x := x + round(cos(a * ctr) * size / 2); p[ctr].y := y + round(sin(a * ctr) * size / 2); end else begin p[1].x := x - size div 2; p[1].y := y - size div 2; p[2].x := x + size div 2; p[2].y := y - size div 2; p[3].x := x + size div 2; p[3].y := y + size div 2; p[4].x := x - size div 2; p[4].y := y + size div 2; end; p[n + 1] := p[1]; end; { !------------------ POLYGON HANDLING ------------------------- } procedure rect_fractal(x, y, size : integer; r : byte); begin if r = 0 then exit; rect_fractal(x - size div 2, y - size div 2, size div 2, r - 1); rect_fractal(x + size div 2, y - size div 2, size div 2, r - 1); rect_fractal(x - size div 2, y + size div 2, size div 2, r - 1); rect_fractal(x + size div 2, y + size div 2, size div 2, r - 1); bar(x - size div 2, y - size div 2, x + size div 2, y + size div 2); rectangle(x - size div 2, y - size div 2, x + size div 2, y + size div 2); end; procedure tri_fractal2(x, y, size : integer; r : byte); var p : array[1..4] of pointtype; begin if r = 0 then exit; p[1].x := x - size div 2; p[1].y := y + size div 2; p[2].x := x; p[2].y := y - size div 2; p[3].x := x + size div 2; p[3].y := y + size div 2; p[4] := p[1]; tri_fractal2(p[1].x + size div 4, p[1].y - size div 4, size div 2, r - 1); tri_fractal2(x, p[2].y + size div 4, size div 2, r - 1); tri_fractal2(p[3].x - size div 4, y + size div 4, size div 2, r - 1); drawpoly(4, p); end; procedure poly_fractal(x, y, n, size : integer; r : byte; hollow : boolean); { n is an integer < maxpoly, equals number of sides. } var ctr : byte; p : polypoints; begin if r = 0 then exit; makepoly(p, x, y, n, size, 0); for ctr := 1 to n do poly_fractal(p[ctr].x, p[ctr].y, n, size div 2, r - 1, hollow); if hollow then drawpoly(n + 1, p) else fillpoly(n + 1, p); end; procedure rotated_poly_fractal(x, y, n, size : integer; r : byte; hollow : boolean; angle : integer); { n is an integer < maxpoly, equals number of sides. } var ctr : byte; p : polypoints; begin if r = 0 then exit; makepoly(p, x, y, n, size, angle); for ctr := 1 to n do poly_fractal(p[ctr].x, p[ctr].y, n, size div 2, r - 1, hollow); if hollow then drawpoly(n + 1, p) else fillpoly(n + 1, p); end; procedure bintree_fractal(x, y, size : integer; r : byte); begin if r = 0 then exit; bintree_fractal(x - size div 2, y - size div 2, size div 2, r - 1); bintree_fractal(x + size div 2, y - size div 2, size div 2, r - 1); line(x, y, x - size div 2, y - size div 2); line(x, y, x + size div 2, y - size div 2); { left branch } { right branch } end; var gd, gm : integer; ctr: byte; a : integer; const rotspeed = 10; begin gd := VGA; gm := VGAHi; initgraph(gd, gm, ''); cleardevice; setcolor(white); setlinestyle(solidln, 0, 0); setfillstyle(closedotfill, blue); settextjustify(centertext, bottomtext); outtextxy(getmaxx div 2, getmaxy div 2, 'Welcome to Sacha''s FractalDemo.'); outtextxy(getmaxx div 2, getmaxy div 2 + 10, 'This program was written in Turbo Pascal on March 23, 1997.'); readkey; cleardevice; bintree_fractal(getmaxx div 2, getmaxy - 10, 300, 10); outtextxy(getmaxx div 2, getmaxy, 'Binary Tree Fractal'); readkey; cleardevice; tri_fractal2(getmaxx div 2, getmaxy div 2, 300, 10); outtextxy(getmaxx div 2, getmaxy, 'TriFractal2 (Pascal''s Fractal)'); readkey; cleardevice; rect_fractal(getmaxx div 2, getmaxy div 2, 200, 7); outtextxy(getmaxx div 2, getmaxy, 'RectFractal (Depth 7)'); readkey; cleardevice; poly_fractal(getmaxx div 2, getmaxy div 2, 5, 200, 5, TRUE); outtextxy(getmaxx div 2, getmaxy, 'Static PolyFractal, Hollow'); readkey; cleardevice; poly_fractal(getmaxx div 2, getmaxy div 2, 5, 200, 6, FALSE); outtextxy(getmaxx div 2, getmaxy, 'Static PolyFractal, Filled'); readkey; cleardevice; outtextxy(getmaxx div 2, getmaxy, 'Rotating PolyFractal'); setviewport(getmaxx div 2 - 200, getmaxy div 2 - 200, getmaxx div 2 + 200, getmaxy div 2 + 200, FALSE); repeat clearviewport; inc(a); if a > 360 then a := a - 360; rotated_poly_fractal(200, 200, 5, 100, 3, TRUE, a); delay(5) until keypressed; setviewport(0, 0, getmaxx, getmaxy, FALSE); readkey; cleardevice; outtextxy(getmaxx div 2, getmaxy div 2 - 30, 'You have just finished Sacha''s FractalDemo.'+ ' I hope you enjoy the'); outtextxy(getmaxx div 2, getmaxy div 2 - 20, 'source code. Please e-mail me at'+ ' sacha@i-manila.com.ph and tell me'); outtextxy(getmaxx div 2, getmaxy div 2 - 10, 'what you think, or pass by '+ 'http://www.geocities.com/SouthBeach/6562.'); readkey; closegraph; end.