Фракталы

Program Gosper_Curve;
 
Uses CRT, GraphABC;
 
Procedure Draw(x, y, l, u : Real; t, q : Integer);
 
Procedure Draw2(Var x, y: Real; l, u : Real; t, q : Integer);
 
Begin
     Draw(x, y, l, u, t, q);
       x := x + l*cos(u);
       y := y - l*sin(u)
End;
 
Begin
     If t > 0 Then
     Begin
          If q = 1 Then
          Begin
               x := x + l*cos(u);
                     y := y - l*sin(u);
                     u := u + pi
          End;
          u := u - 2*pi/19;
              l := l/sqrt(7);
              Draw2(x, y, l, u, t-1, 0);
              Draw2(x, y, l, u+pi/3, t-1, 1);
              Draw2(x, y, l, u+pi, t-1, 1);
          Draw2(x, y, l, u+2*pi/3, t-1, 0);
          Draw2(x, y, l, u, t-1, 0);
          Draw2(x, y, l, u, t-1, 0);
          Draw2(x, y, l, u-pi/3, t-1, 1)
     End
     Else
         Line(Round(x), Round(y), Round(x + cos(u)*l), Round(y -sin(u)*l))
     End;
 
Begin
     SetWindowCaption('Фракталы: Кривая Госпера');
     SetWindowSize(650,500);
     ClearWindow;
     Draw(100, 355, 400, 0, 4, 0);
     Repeat Until KeyPressed
End.

uses CRT, GraphABC;
 
Procedure Rect(x1, y1, l: Integer; a1: Real);
Begin
     MoveTo(x1, y1);
       LineTo(x1 + Round(l * cos(a1)), y1 - Round(l * sin(a1)));
       LineTo(x1 + Round(l * sqrt(2) * cos(a1 + pi/4)),
         y1 - Round(l * sqrt(2) * sin(a1 + pi/4)));
       LineTo(x1 + Round(l * cos(a1 + pi/2)), y1 - Round(l * sin(a1 + pi/2)));
       LineTo(x1, y1)
End;
 
Procedure Draw(x, y, l, a: Real);
Begin
     If l > 4 Then
     Begin
              Rect(Round(x), Round(y), Round(l), a);
              Draw(x - l*sin(a), y - l * cos(a), l / sqrt(2), a + pi / 4);
              Draw(
                     x - l * sin(a) + l / sqrt(2) * cos(a + pi/4),
                     y - l * cos(a) - l / sqrt(2) * sin(a + pi/4),
                     l / sqrt(2),
               a - pi/4)
     End
End;
Begin
     SetWindowCaption('Фракталы: Дерево Пифагора');
     SetWindowSize(730,500);
     ClearWindow;
     Draw(280, 460, 100, 0);
       Repeat Until KeyPressed
End.

Uses CRT, GraphABC;
Const Z = 6; {Глубина фрактала}
Var
   x1, y1, x2, y2, x3, y3: Real;
 
Procedure Serp(x1, y1, x2, y2: Real; n: Integer);
Var
   x1n, y1n, x2n, y2n: Real;
Begin
     If  n > 0  Then
     Begin
          x1n := 2*x1/3 + x2 / 3;
          x2n := x1/3 + 2*x2 / 3;
          y1n := 2*y1/3 + y2 / 3;
          y2n := y1/3+2*y2 / 3;
          Rectangle(Round(x1n), Round(y1n), Round(x2n), Round(y2n));
          Serp(x1, y1, x1n, y1n, n-1);
          Serp(x1n, y1, x2n, y1n, n-1);
          Serp(x2n, y1, x2, y1n, n-1);
          Serp(x1, y1n, x1n, y2n, n-1);
          Serp(x2n, y1n, x2, y2n, n-1);
          Serp(x1, y2n, x1n, y2, n-1);
          Serp(x1n, y2n, x2n, y2, n-1);
          Serp(x2n, y2n, x2, y2, n-1)
     End
End;
Begin
     SetWindowCaption('Фракталы: Ковер Серпинского');
     SetWindowSize(500,500);
     ClearWindow;
     Rectangle(20, 20, 460, 460);
     Serp(20, 20, 460, 460, Z);
     Repeat Until Keypressed
End.

Uses CRT, GraphABC;
Const Z = 7; {Глубина фрактала}
 
Procedure tr(x1, y1, x2, y2, x3, y3: Real);
Begin
     Line(Round(x1), Round(y1), Round(x2), Round(y2));
       Line(Round(x2), Round(y2), Round(x3), Round(y3));
       Line(Round(x3), Round(y3), Round(x1), Round(y1));
End;
 
Procedure draw(x1, y1, x2, y2, x3, y3: Real; n: Integer);
Var
   x1n, y1n, x2n, y2n, x3n, y3n : Real;
Begin
     If  n > 0  Then
     Begin
          x1n := (x1 + x2) / 2;
          y1n := (y1 + y2) / 2;
          x2n := (x2 + x3) / 2;
          y2n := (y2 + y3) / 2;
          x3n := (x3 + x1) / 2;
          y3n := (y3 + y1) / 2;
          tr(x1n, y1n, x2n, y2n, x3n, y3n);
          draw(x1, y1, x1n, y1n, x3n, y3n, n - 1);
          draw(x2, y2, x1n, y1n, x2n, y2n, n - 1);
          draw(x3, y3, x2n, y2n, x3n, y3n, n - 1)
     End
End;
Begin
     SetWindowCaption('Фракталы: Треугольник Серпинского');
     SetWindowSize(650,500);
     ClearWindow;
     tr(320,10,600,470,40,470);
       draw(320,10,600,470,40,470,Z);
     Repeat Until KeyPressed
End.

Uses Crt, GraphABC;
Const
     u = 10;
       p = 5;
Var
   i: Integer;
 
{В PascalABC нет функции LineRel - искусственно реализуем ее через LineTo}
Procedure LineRel(dx, dy : Integer);
Begin
     LineTo(PenX+dx, PenY+dy)
End;
 
Procedure a(i: Integer); forward;
Procedure b(i: Integer); forward;
Procedure c(i: Integer); forward;
Procedure d(i: Integer); forward;
 
Procedure a(i: Integer);
Begin
     If i > 0 Then
     Begin
          d(i - 1);
          LineRel( + u, 0);
              a(i - 1);
              LineRel(0, u);
              a(i - 1);
              LineRel(-u, 0);
              c(i - 1)
     End
End;
 
Procedure b(i: integer);
Begin
     If i > 0 Then
     Begin
          c(i - 1);
              LineRel(-u, 0);
              b(i - 1);
              LineRel(0, -u);
              b(i - 1);
              LineRel(u, 0);
              d(i - 1)
     End
End;
 
Procedure c(i: integer);
Begin
     If i > 0 Then
     Begin
          b(i - 1);
          LineRel(0, -u);
              c(i - 1);
              LineRel(-u, 0);
              c(i - 1);
              LineRel(0, u);
              a(i - 1)
     End
End;
 
Procedure d(i: integer);
Begin
     If i > 0 Then
     Begin
          a(i - 1);
              LineRel(0, u);
              d(i - 1);
              LineRel(u, 0);
              d(i - 1);
              LineRel(0, -u);
              b(i - 1)
     End
End;
{Main Program}
Begin
     SetWindowCaption('Фракталы: Кривая Гильберта');
     SetWindowSize(500,500);
     ClearWindow;
     MoveTo(100, 100);
       a(p);
     Repeat until KeyPressed
End.

uses CRT, GraphABC;
 
procedure Draw(x, y, l, u : Real; t : Integer);
 
procedure Draw2(Var x, y: Real; l, u : Real; t : Integer);
 
begin
    Draw(x, y, l, u, t);
    x := x + l*cos(u);
    y := y - l*sin(u);
end;
 
begin
    if t > 0 then
    begin
        l := l/3;
        Draw2(x, y, l, u, t-1);
        Draw2(x, y, l, u+pi/3, t-1);
        Draw2(x, y, l, u-pi/3, t-1);
        Draw2(x, y, l, u, t-1);
    end
    else
        Line(Round(x), Round(y), Round(x+cos(u)*l), Round(y-sin(u)*l))
end;
 
begin
  SetWindowSize(425,500);
  SetWindowCaption('Фракталы: Снежинка Коха');
    Draw(10, 354, 400, pi/3, 4);
    Draw(410, 354, 400, pi, 4);
    Draw(210, 8, 400, -pi/3, 4);
 Repeat Until KeyPressed
end.

uses GraphABC;
 
const
  n=255;
  max=10;
 
var
  x,y,x1,y1,cx,cy: real;
  i,ix,iy: integer;
// z=z^2+c
begin
  SetWindowSize(400,300);
  SetWindowCaption('Фракталы: множество Мандельброта');
  for ix:=0 to WindowWidth-1 do
  for iy:=0 to WindowHeight-1 do
  begin
    x:=0;
    y:=0;
    cx:=0.002*(ix-720);
    cy:=0.002*(iy-150);
    for i:=1 to n do
    begin
      x1:=x*x-y*y+cx;
      y1:=2*x*y+cy;
      if (x1>max) or (y1>max) then break;
      x:=x1;
      y:=y1;
    end;
    if i>=n then SetPixel(ix,iy,clRed)
      else SetPixel(ix,iy,RGB(255,255-i,255-i));
  end;
end.

uses GraphABC;
 
const
  n=255;
  max=10;
 
var
  x,y,x1,y1,cx,cy: real;
  i,ix,iy: integer;
// z=z^2+c
begin
  SetWindowSize(600,600);
  SetWindowCaption('Фракталы: множество Мандельброта');
  for ix:=0 to WindowWidth-1 do
  for iy:=0 to WindowHeight-1 do
  begin
    x:=0;
    y:=0;
    cx:=0.005*(ix-365);
    cy:=0.005*(iy-300);
    for i:=1 to n do
    begin
      x1:=x*x-y*y+cx;
      y1:=2*x*y+cy;
      if (x1>max) or (y1>max) then break;
      x:=x1;
      y:=y1;
    end;
    if i>=n then SetPixel(ix,iy,clRed)
      else SetPixel(ix,iy,RGB(255,255-i,255-i));
  end;
end.

uses CRT, GraphABC;
var 
    x, y, a, b: Real;
    r: Real;
    a0, b0: Real;
    a1, b1, a2, b2: Real;
    f1x, f1y: Real;
    x1, y1: Real;
    
begin
    setwindowcaption('Фракталы: Множество Апполона');
  setwindowsize(650, 500);
  clearwindow;
    x := 0.2;
    y := 0.3;
    a := 0;
    b := 0;
    Randomize;
    r := Sqrt(3);
    while not KeyPressed do 
    begin
        a := Random;
        a0 := 3*(1+r-x)/(sqr(1+r-x)+sqr(y))-(1+r)/(2+r);
        b0 := 3*y/(sqr(1+r-x)+sqr(y));
        if (a <= 1/3) and (a>=0) then 
        begin
            x1 := a0;
            y1 := b0;
        end;
        a1 := -1/2;
        b1 := r/2;
        a2 := -1/2;
        b2 := -r/2;
        f1x := a0/(sqr(a0)+sqr(b0));
        f1y := -b0/(sqr(a0)+sqr(b0));
        if (a <= 2/3) and (a > 1/3) then 
        begin
            x1 := f1x*a1-f1y*b1;
            y1 := f1x*b1+f1y*a1;
        end;
        if (a <= 3/3) and (a > 2/3) then 
        begin
            x1 := f1x*a2-f1y*b2;
            y1 := f1x*b2+f1y*a2;
        end;
        x := x1;
        y := y1;
        PutPixel(320+Round(x*50), 240+Round(y*50), clRed);
    end;
    ReadKey 
end.

uses CRT, GraphABC;
 
procedure Draw(x, y, l, u : Real; t : Integer);
 
procedure Draw2(Var x, y: Real; l, u : Real; t : Integer);
begin
    Draw(x, y, l, u, t);
    x := x + l*cos(u);
    y := y - l*sin(u);
end;
begin
    if t > 0 then
    begin
        l := l*0.5;
        Draw2(x, y, l, u, t-1);
        Draw2(x, y, l*0.8, u+pi/2, t-1);
        Draw2(x, y, l*0.8, u-pi/2, t-1);
        Draw2(x, y, l, u, t-1)
    end
    else
        Line(Round(x), Round(y), Round(x+cos(u)*l), Round(y-sin(u)*l))
end;
 
begin
  SetWindowCaption('Фракталы: Ледяной фрактал 1');
  SetWindowSize(420,420);
    Draw(410, 10, 400, -pi, 5);
    Draw(10, 410, 400, 0, 5);
    Draw(10, 10, 400, -pi/2, 5);
    Draw(410, 410, 400, pi/2, 5);
    ReadKey
end.

uses CRT, GraphABC;
 
procedure Draw(x, y, l, u : Real; t : Integer);
procedure Draw2(Var x, y: Real; l, u : Real; t : Integer);
 
begin
    Draw(x, y, l, u, t);
    x := x + l*cos(u);
    y := y - l*sin(u);
end;
 
begin
    if t > 0 then
    begin
        l := l*0.5;
        Draw2(x, y, l, u, t-1);
        Draw2(x, y, l*0.45, u+2*pi/3, t-1);
        Draw2(x, y, l*0.45, u-pi/3, t-1);
        Draw2(x, y, l*0.45, u+pi/3, t-1);
        Draw2(x, y, l*0.45, u-2*pi/3, t-1);
        Draw2(x, y, l, u, t-1)
    end
    else
        Line(Round(x), Round(y), Round(x+cos(u)*l), Round(y-sin(u)*l))
end;
 
begin
  SetWindowCaption('Фракталы: Ледяной фрактал 2');
  SetWindowSize(420,420);
    Draw(210, 8, 400, -2*pi/3, 3);
    Draw(10, 354, 400, 0, 3);
    Draw(410, 354, 400, 2*pi/3, 3);
    ReadKey
end.

uses graphABC,crt;
procedure koh(x1,y1,x2,y2,x3,y3,k:integer);
var xxs,yys,xx1,yy1,xx2,yy2,xx3,yy3:integer;
al:real;
begin
 if k>0 then
 begin
 {t1,t2}
 xx1:=round((2*x1+x2)/3);
 yy1:=round((2*y1+y2)/3);
 xx2:=round((2*x2+x1)/3);
 yy2:=round((2*y2+y1)/3);
 {t3}
 xxs:=round((x1+x2)/2);
 yys:=round((y1+y2)/2);
 xx3:=abs(round((4*xxs-x3)/3));
 yy3:=abs(round((4*yys-y3)/3));
 {risuem 1-3,3-2}
 SetpenColor(clBlack);
 Setpenwidth(1);
 MoveTo(xx1,yy1);
 LineTo(xx3,yy3);
 LineTo(xx2,yy2);
 koh(xx1,yy1,xx3,yy3,xx2,yy2,k-1);
 koh(xx3,yy3,xx2,yy2,xx1,yy1,k-1);
 koh(x1,y1,xx1,yy1,round((2*x1+x3)/3),round((2*y1+y3)/3),k-1);
 koh(x2,y2,xx2,yy2,round((2*x2+x3)/3),round((2*y2+y3)/3),k-1);
 end;
end;
 
var n,xc,yc,x1,y1,x2,y2,x3,y3,a:integer;
    h:real;
begin
repeat
write('Глубина рекурсии [1..8] n=');
read(n);
until n in [1..8];
hidecursor;
xc:=windowwidth div 2;{centr ekrana}
yc:=windowheight div 2;
a:=300;
h:=a*sin(pi/3);{vysota treugilnika}
x1:=xc-a div 2;
y1:=yc+round(h/3);
x2:=xc;
y2:=yc-round(2*h/3);
x3:=xc+a div 2;
y3:=y1;
Moveto(x1,y1);
LineTo(x2,y2);
LineTo(x3,y3);
LineTo(x1,y1);
koh(x1,y1,x2,y2,x3,y3,n);
koh(x2,y2,x3,y3,x1,y1,n);
koh(x3,y3,x1,y1,x2,y2,n);
end.

uses graphABC;
const k=8;
var x,y:integer;
procedure snow (x0,y0,r,n:integer);
const t=2*pi/k;
var i,x,y:integer;
begin
 for i:=1 to k do
  begin
   x:=x0+round(r*cos(i*t));
   y:=y0-round(r*sin(i*t));
   line(x0,y0,x,y);
   if n>1 then snow(x,y,r div 5,n-1);
  end;
end;
begin
SetWindowSize(500,500);
SetWindowCaption('Фракталы: что-то похожее на снежинку');
x:=windowwidth div 2;
y:=windowheight div 2;
snow(x,y,180,4);
end.

uses GraphABC;
procedure Draw (x,y,size:integer);
 var min,m,n:integer;
     i,s1,s2:integer;
 begin
  min:=1;m:=6;n:=3;
  if size > min 
   then
    begin
     s1:=round(size/n );
     s2:=round(size*(n-1)/n );
     for i:= 1 to  m do
      Draw ( x - round ( s2*sin ( 2*pi/m*i ) ) , y + round ( s2*cos ( 2*pi/m*i ) ) , s1 );
     Draw ( x, y, s1 );
    end;
  ellipse ( x - size, y - size, x + size, y + size );
 end; 
begin
  SetBrushStyle(bsclear);
  SetWindowTitle('Фракталы: круговой фрактал');
  Draw(320,240,200);
end.

uses GraphABC;
 
const
  n=255;
  max=10;
 
var
  x,y,x1,y1,cx,cy: real;
  i,ix,iy: integer;
// z=z^2+c
begin
  SetWindowCaption('Фракталы: отпечаток пальца');
  SetWindowSize(400,300);
  cx:=0.1;
  cy:=+0.17;
  for ix:=0 to WindowWidth-1 do
  for iy:=0 to WindowHeight-1 do
  begin
    x:=0.005*(ix-200);
    y:=0.005*(iy-150);
    for i:=1 to n do
    begin
      x1:=x*x-y*y+cx;
      y1:=x*y+1.4*y+cy;
      if (x1>max) or (y1>max) then break;
      x:=x1;
      y:=y1;
    end;
    if i>=n then SetPixel(ix,iy,clRed)
      else SetPixel(ix,iy,RGB(255,255-i,255-i));
  end;
end.

uses GraphABC,Utils;
 
const
  n=255;
  max=10;
 
var
  x,y,x1,y1,cx,cy: real;
  i,ix,iy: integer;
// z=z^2+c
begin
  SetWindowCaption('Фракталы: папоротник');
  SetWindowSize(300,300);
  cx:=0.251;
  cy:=0.95;
  for ix:=0 to WindowWidth-1 do
  for iy:=0 to WindowHeight-1 do
  begin
    x:=0.001*(ix-200);
    y:=0.001*(iy-150);
    for i:=1 to n do
    begin
      x1:=0.5*x*x-0.88*y*y+cx;
      y1:=x*y+cy;
      if (x1>max) or (y1>max) then break;
      x:=x1;
      y:=y1;
    end;
    if i>=n then SetPixel(ix,iy,clGreen)
      else SetPixel(ix,iy,RGB(255-i,255,255-i));
  end;
  writeln('Время расчета = ',Milliseconds/1000,' с');
end.

Uses CRT, GraphABC;
Const Z= 12; {Glubina Fraktala}
Procedure ris(x1,y1,x2,y2,k:integer);
Var xn,yn:integer;
Begin
     If k>0 Then
     Begin
          xn:=(x1+x2) div 2 +(y2-y1) div 2;
          yn:=(y1+y2) div 2 -(x2-x1) div 2;
          ris(x1,y1,xn,yn,k-1);
          ris(x2,y2,xn,yn,k-1)
     End
     Else
          line(x1,y1,x2,y2)
 
End;
{Main program}
Begin
     SetWindowCaption('Фракталы: Кривая Дракона');
     SetWindowSize(700,512);
     ClearWindow;
     ris(200,300,500,300,Z);
     Repeat Until KeyPressed
End.

Uses GraphABC;
Procedure Tree(x, y: Integer; a: Real; l: Integer);
Var
   x1, y1: Integer;
   p, s : Integer;
   i : Integer;
   a1 : Real;   
Begin
     If l < 8 Then
     exit;
     x1 := Round(x + l*cos(a));
     y1 := Round(y + l*sin(a));
     If l > 100 Then p := 100 Else p := l;
     If p < 40 Then
     Begin
          {Генерация листьев}
          If Random > 0.5 Then SetPenColor(clLime) Else SetPenColor(clGreen);
          For i := 0 To 3 Do
              Line(x + i, y, x1, y1)
     End
     Else
     Begin
          {Генерация веток}
          SetPenColor(clBrown);
          For i := 0 To (p div 6) Do
              Line(x + i - (p div 12), y, x1, y1)
     End;
     {Следующие ветки}
     For i := 0 To 9 - Random(9) Do
     Begin
          s := Random(l - l div 6) + (l div 6);
          a1 := a + 1.6 * (0.5 - Random); {Угол наклона веток}
          x1 := Round(x + s * cos(a));
          y1 := Round(y + s * sin(a));
          Tree(x1, y1, a1, p - 5 - Random(30)) {Чем меньше вычитаем, тем пышнее дерево}
     End
End;
 
{Основная программа}
Begin
  SetWindowCaption('Фрактальное дерево');
  SetWindowSize(700,600);
  Randomize;
  Tree(350, 580, 3*pi/2, 200)    
End.

uses CRT, GraphABC;
Const
     Z = 50000;
Procedure Draw;
Var
   t, x, y, p : Real;
     k : LongInt;
     mx, my, rad : Integer;
Begin
     mx := 10;
       my := 250;
       rad :=600;
       Randomize;
       x := 0.0;
       y := 0.0;
       For k := 1 To Z do
       Begin
         p := Random;
         t := x;
         If p <= 1/2 Then
         Begin
              x :=  1/2 * x + 1/(2*sqrt(3)) * y;
              y :=  1/(2*sqrt(3)) * t - 1/2 * y;
         End
         Else
         Begin
              x :=  1/2 * x - 1/(2*sqrt(3)) * y +1/2;
              y :=  -1/(2*sqrt(3)) * t - 1/2 * y + 1/(2*sqrt(3))
         End;
         PutPixel(mx + Round(rad * x), my - Round(rad * y), clRed)
    End
End;
{main program}
Begin
     SetWindowCaption('Фракталы: Кривая Коха');
     SetWindowSize(650,400);
     ClearWindow;
     Draw;
     Repeat Until KeyPressed
End.

uses GraphABC;
const
    max = 3;
  
procedure LineTo1(x, y : Integer; l, u : Real);
begin
    Line(x, y, Round(x + l * cos(u)), Round(y - l * sin(u)));
end;
 
procedure Draw(x, y : Integer; l, u : real);
begin   
    if l > max then
    begin
        l := l * 0.7;
        LineTo1(x, y, l, u);
        x := Round(x + l * cos(u));
        y := Round(y - l * sin(u));
        Draw(x, y, l, u + pi / 4); {Угол поворота 1}
        Draw(x, y, l, u - pi / 6); {Угол поворота 2}
    end;
end;
 
begin   
   SetWindowCaption('Фракталы: Дерево Пифагора');
   SetWindowSize(730,500);
   ClearWindow;
   Draw(320, 460, 200, pi/2)   
end.

uses GraphABC;
const
    min = 1;
    
procedure lineto1(x, y : Integer; l, u : real);
begin
    Line(x, y, Round(x + l * cos(u)), Round(y - l * sin(u)));
end;
 
procedure Draw(x, y : Integer; l, u : real);
 
begin
    if l > min then 
    begin
        lineto1(x, y, l, u);
        x := Round(x + l * cos(u));
        y := Round(y - l * sin(u));
        Draw(x, y, l*0.4, u - 14*pi/30);
        Draw(x, y, l*0.4, u + 14*pi/30);
        Draw(x, y, l*0.7, u + pi/30);
    end;
end;
 
begin
     SetWindowCaption('Фракталы: Папоротник');
   SetWindowSize(730,500);
   ClearWindow;
    Draw(320, 460, 140, pi/2)   
end.

uses GraphABC;
var
  x,y : integer;
  dx,dy: integer;
  turn: array [1..1000] of Boolean;
  a,b,d,t: integer;
  f: Boolean;
  i: integer;
begin
  SetWindowSize(790,500);
  SetWindowCaption('Фракталы. Кривая Дракона');
  f:=true;
  for a := 1 to 64 do
  begin
    turn[2*a-1]:=f;
    f:=not f;
    turn[2*a]:=turn[a];
  end;
  x:=200; dx:=0;
  y:=140; dy:=-4;
  b:=0;
  d:=1;
  f:=false;
  MoveTo(x,y);
  for a:=1 to 128 do
  begin
    for i:=1 to 127*4 do
    begin
      b := b+d; x:=x+dx; y:=y+dy;
      LineTo(x,y);
      if f and not turn[b] or not f and turn[b] then
      begin
        t:=dy;
        dy:=-dx;
      end
      else
      begin
        t:=-dy;
        dy:=dx;
      end;
      dx:=t;
    end;
    b:=b+d; d:=-d;
    f:=not f;
    x:=x+dx; y:=y+dy;
    LineTo(x,y);
    if turn[a] then
    begin
      t:=dy;
      dy:=-dx;
    end
    else
    begin
      t:=-dy;
      dy:=dx;
    end;
    dx:=t;
  end;
end.

uses GraphABC;
const
    min = 1;
 
procedure Draw(x, y : Real; Size : Real);
var
    s : Real;
 
begin
    if size > min then 
    begin
        s := size / 3;
        Draw(x, y + 20, s);
        Draw(x + s * 2, y + 20, s);
    end;
    Rectangle(Round(x), Round(y), Round(x + size), Round(y + 5))
end;
 
begin
    SetWindowCaption('Фракталы: Канторова пыль');
  SetWindowSize(520,160);
  ClearWindow;
    Draw(10,30,500) 
end.

uses GraphABC;
 
procedure Draw;
const iter = 50000;
var
    t, x, y, p : Real;
    k : LongInt;
    mx, my, rad : Integer;
begin
    mx := 200;
    my := 300;
    rad := 250;
    Randomize;
    x := 0.0;
    y := 0.0;
    for k := 1 to iter do 
    begin
        p := Random;
        t := x;
        if p <= 1/2 then 
        begin
            x := 0.5*x - 0.5*y;
            y := 0.5*t + 0.5*y;
        end
        else
        begin
            x := 0.5*x + 0.5*y + 0.5;
            y := -0.5*t + 0.5*y + 0.5;
        end;
        PutPixel(mx + Round(rad * x), my - Round(rad * y), clBlue);
    end;
end;
 
begin
    SetWindowCaption('Фракталы: Кривая Леви');
  SetWindowSize(650,450);
  ClearWindow;
    Draw
end.

uses GraphABC;
 
procedure Draw(x, y, l, u : Real; t, q,s : Integer);
 
procedure Draw2(Var x, y: Real; l, u : Real; t, q, s : Integer);
begin
    Draw(x, y, l, u, t, q, s);
    x := x + l*cos(u);
    y := y - l*sin(u);
end;
 
begin
    if t > 0 then 
    begin
        if q = 1 then 
        begin
            x := x + l*cos(u);
            y := y - l*sin(u);
            s := -s;
            u := u + pi
        end 
        else if q = 3 then 
        begin
            x := x + l*cos(u);
            y := y - l*sin(u);
            s := s;
            u := u + pi
        end 
        else if q = 2 then 
        begin
            s:=-s
        end 
        else if q = 0 then 
        begin
            s := s
        end;
        l := l/3;
        Draw2(x, y, l,           u+s*pi/3,   t-1, 2,s);
        Draw2(x, y, l,           u+s*pi/3,   t-1, 1,s);
        Draw2(x, y, l,           u,          t-1, 0,s);
        Draw2(x, y, l,           u-s*pi/3,   t-1, 1,s);
        Draw2(x, y, l*sqrt(3)/3, u-s*7*pi/6, t-1, 1,s);
        Draw2(x, y, l*sqrt(3)/3, u-s*7*pi/6, t-1, 2,s);
        Draw2(x, y, l*sqrt(3)/3, u-s*5*pi/6, t-1, 3,s);
        Draw2(x, y, l*sqrt(3)/3, u-s*pi/2,   t-1, 3,s);
        Draw2(x, y, l*sqrt(3)/3, u-s*pi/2,   t-1, 0,s);
        Draw2(x, y, l,           u,          t-1, 3,s);
        Draw2(x, y, l,           u,          t-1, 0,s);
 
    end
    else 
        Line(Round(x), Round(y), Round(x + cos(u)*l), Round(y - sin(u)*l));
end;
 
begin
    SetWindowCaption('Фракталы: Обезьянье дерево');
  SetWindowSize(520,500);
  ClearWindow;
    Draw(50, 365, 430, 0, 3, 0, 1)
end.

uses graphabc;
const 
  k = 2.6;
  n = 4; {глубина 1-6}
var x, y, r : integer;
{функция рисования, x,y-координаты цента,r-начальный радиус, n-глубина рекурсии}
function ris(x, y, r, n : integer) : integer;
begin
  if n = 0 then ris := 0
  else
  begin
    circle(x,y,r);
    dec(n);
    ris := ris(x + round(k * r), y, round(r / k), n);
    ris := ris(x - round(k * r), y, round(r / k), n);
    ris := ris(x, y - round(k * r), round(r / k), n);
    ris := ris(x, y + round(k * r), round(r / k),n)
  end
end;
 
begin
  r := 50;  
  SetWindowSize(500, 500);
  SetWindowCaption('Фракталы: крест из окружностей');
  x := windowwidth div 2;
  y := windowheight div 2;
  ris(x,y,r,n)  
end.

uses  GraphABC;
 
procedure Draw(x, y, l, u : Real; t : Integer);
procedure Draw2(var x, y: Real; l, u : Real; t : Integer);
begin
 Draw(x, y, l, u, t);
 x := x + l*cos(u);
 y := y - l*sin(u);
end;
 
begin
 if t > 0 then begin
    l := l/3;
    Draw2(x, y, l, u, t-1);
    Draw2(x, y, l, u+pi/2, t-1);
    Draw2(x, y, l, u, t-1);
    Draw2(x, y, l, u-pi/2, t-1);
    Draw2(x, y, l, u, t-1);
  end
 else Line(Round(x), Round(y), Round(x+cos(u)*l), Round(y-sin(u)*l))
end;
 
begin
 Draw(20, 320, 600, 0, 4);
end.