Программа для построения фрактала Кох

Program fr_kox;

uses graph,crt;

var x0,y0,x,y,gd,gm:integer;x1,y1:real;

{*** рекурсивная процедура построения линии Коха ***}

procedure kox(xn,yn,xk,yk:real);

var x2,y2,x3,y3,x4,y4:real; c:char;

begin

if abs(xn-xk)<2 then exit;

x2:=xn+(xk-xn)/3; y2:=yn+(yk-yn)/3;

x3:=xn+(xk-xn)*2/3; y3:=yn+(yk-yn)*2/3;

x4:=x2+(x3-x2)*cos(pi/3)+(y3-y2)*sin(pi/3);

y4:=y2-(x3-x2)*sin(pi/3)+(y3-y2)*cos(pi/3);

line(round(x2),round(y2),round(x4),round(y4));

line(round(x3),round(y3),round(x4),round(y4));

if keypressed then halt;

kox(xn,yn,x2,y2); {рекурсивные вызовы}

kox(x2,y2,x4,y4);

kox(x4,y4,x3,y3);

kox(x3,y3,xk,yk);

end;

begin

x0:=50; y0:=250;

x:=590; y:=250;

gd:=Detect;

initgraph(gd,gm,'C:\BP\BGI');

setcolor(10);

line(x0,y0,x,y);

kox(x0,y0,x,y); {Рисование фрактала - линии Коха}

readkey;

cleardevice;

{Рисование фрактального треугольника с использованием}

{процедуры для построения линии Коха}

x0:=150; y0:=320;

x:=490; y:=320;

x1:=x0+(x-x0)*cos(pi/3)+(y-y0)*sin(pi/3);

y1:=y0-(x-x0)*sin(pi/3)+(y-y0)*cos(pi/3);

kox(x0,y0,x1,y1);

kox(x1,y1,x,y);

kox(x,y,x0,y0);

readkey;

closegraph

end.

Программа для построения ветки папоротника

Program fr_paporotnik;

uses crt, graph;

const alfa=80;beta=2.1; k=0.3; k1=0.5; lmin=1;

var a,b,c,d,e,f,g,h:real; gd,gm:integer;

{*** рекурсивная процедура на основе метода IFS ***}

procedure step(x1,y1,x2,y2:real; nom:integer);

var x3,y3,x4,y4,x5,y5,x6,y6,x7,y7:real;

begin

if sqr(x1-x2)+sqr(y1-y2)>lmin then

begin

{координаты точек вычисляются по формулам}

x3:=(x2-x1)*a-(y2-y1)*b+x1; y3:=(x2-x1)*b+(y2-y1)*a+y1;

x4:=x1*c+x3*d; y4:=y1*c+y3*d;

x5:=x4*e+x3*f; y5:=y4*e+y3*f;

x6:=(x5-x4)*g-(y5-y4)*h+x4; y6:=(x5-x4)*h+(y5-y4)*g+y4;

x7:=(x5-x4)*g+(y5-y4)*h+x4; y7:=(x5-x4)*(-h)+(y5-y4)*g+y4;

line(round(x1),round(y1),round(x4),round(y4));

{рекурсивные вызовы для рисования фрагментов фрактала}

step(x4,y4,x3,y3,nom);

step(x4,y4,x6,y6,nom+1);

step(x4,y4,x7,y7,nom+1);

end;

end;

begin

gd:=Detect;

initgraph(gd,gm,'C:\BP\BGI');

setBkcolor(1);

{вычисление коэффициентов}

a:=cos(pi/alfa); b:=sin(pi/alfa);

c:=1-k; d:=k;

e:=1-k1; f:=k1;

g:=cos(pi/beta); h:=sin(pi/beta);

step(200,350,225,70,0); {рисование ветки папоротника}

readkey;

closegraph

end.

Программа построения треугольника Серпинского

program fr_treug_serpinsky;

uses graph,crt;

const m=2500; { количество точек фрактала }

type koord=array[1..3] of integer;

var gd,gm: integer;

x,y: koord; { массивы координат }

{**** Процедура заполнения заданного треугольника точками ****}

procedure serpinsky(xs,ys:koord);

var x0,y0,xk,yk: real; n,k: integer;

begin

randomize;

x0:=(xs[1]+xs[2]+xs[3])/3; { координаты начальной точки }

y0:=(ys[1]+ys[2]+ys[3])/3;

for k:=1 to m do

begin

n:=random(3)+1; { случайная вершина }

xk:=(x0+xs[n])/2; { середина отрезка, соединяющего }

yk:=(y0+ys[n])/2; { начальную точку с вершиной }

putpixel(round(xk), round(yk), 12); { вывод точки }

x0:=xk; { новые координаты для начальной точки }

y0:=yk

end;

end;

begin

gd:=Detect;

initgraph(gd,gm,'C:\BP\BGI');

setcolor(10);

setviewport(20,20,500,250, true);

x[1]:=320; y[1]:=50; { координаты вершин треугольника }

x[2]:=150; y[2]:=200;

x[3]:=450; y[3]:=200;

serpinsky(x,y); { процедура вывода треугольника Серпинского }

readkey;

closegraph

end.