Фрактал

[marat-link]

Помогите, пожалуйста дорисовать следующий фрактал: https://dl.dropbox.com/u/51294544/1.png
Код моей программы:

uses
    graph, crt;

var
   driver, mode: integer;
   rx, ry: integer;
   Sx, Sy: real;
   hu, hv: real;
   fi: real;

procedure Init;
begin
     driver:= detect;
     InitGraph(driver, mode, '');
     rx:= 50;
     ry:= 50;
     Sx:=GetMaxX/rx;
     Sy:=GetMaxY/ry;
     hu:=3;
     hv:=GetMaxY-3;
     fi:= PI/2;
end;

procedure OutLine(x1, y1, x2, y2: real);
var
   u1, v1, u2, v2: integer;
begin
     u1:=round(x1*Sx+Hu);
     v1:=round(-y1*sy+Hv);
     u2:=round(x2*Sx+Hu);
     v2:=round(-y2*Sy+Hv);
     Line(u1,v1,u2,v2);
end;

procedure Draw(x1, y1, x2, y2: real; n: integer);
var
   x3, y3, x4, y4, x5, y5, x6, y6: real;
   dx, dy: real;
begin
     dx:=(x2-x1)/3;
     dy:=(y2-y1)/3;

     x3:=x1+dx;
     y3:=y1+dy;

     x4:=dx*cos(-fi)-dy*sin(-fi)+x3;
     y4:=dx*sin(-fi)+dy*cos(-fi)+y3;

     x5:=x3+dx;
     y5:=y3+dy;

     x6:=dx*cos(fi)-dy*sin(fi)+x5;
     y6:=dx*sin(fi)+dy*sin(fi)+y5;

     if (n > 0) then
     begin
          draw(x1,y1,x3,y3,n-1);
          draw(x3,y3,x4,y4,n-1);
          draw(x4,y4,x6,y6,n-1);
          draw(x6,y6,x5,y5,n-1);
          draw(x5,y5,x2,y2,n-1);
     end else
         outline(x1,y1,x2,y2);
end;

begin
     Init;
     Draw(10,20,20,20,1);
     Repeat Until KeyPressed;
     CloseGraph;
end.

[TinMan]

Держи. Я немного поменял твою графику, она показалась мне неудобной (хотя бы уже потому, что не сохраняет масштаб между X и Y).
Всякие синусы, косинусы и прочую требуху я выкинул - тут они не нужны.

uses
  graph, wincrt;   // wincrt - это для FreePascal, для Turbo используй CRT

const
  ScreenHeight_cm= 20;  // высота экрана в сантиметрах

var
  driver, mode: integer;
  rx, ry: integer;
  S: real;
  hu, hv: real;
  fi: real;
  u1,v1: real;  // graph area limits

procedure Init;
begin
  driver:= detect;
  InitGraph(driver, mode, '');
  // начало координат помещаем в центр экрана
  v1:= -ScreenHeight_cm/2;
  u1:= -ScreenHeight_cm*GetMaxX/GetMaxY/2;
  S:= GetMaxY/ScreenHeight_cm;
end;


procedure Draw(x1, y1, x2, y2: real; n: integer);
var
  dx, dy: real;
begin
  if n=0 then
    Line(round((x1-u1)*S),GetMaxY-round((y1-v1)*S),round((x2-u1)*S),GetMaxY-round((y2-v1)*S))
  else begin
    dx:=(x2-x1)/3;
    dy:=(y2-y1)/3;
    draw(x1,y1,x1+dx,y1+dy,n-1);
    draw(x1+dx,y1+dy,x1+dx+dy,y1+dy-dx,n-1);
    draw(x1+dx+dy,y1+dy-dx,x2-dx-dy,y2-dy+dx,n-1);
    draw(x2-dx-dy,y2-dy+dx,x2-dx,y2-dy,n-1);
    draw(x2-dx,y2-dy,x2,y2,n-1);
  end
end;

begin
  Init;
  Draw(-13,-1,13,1,7);
  ReadKey;
  CloseGraph;
end.

Сам фрактал я немного повернул целиком - специально, чтоб продемонстрировать, что это возможно. Чтоб пасположить его строго горизонтально, используй начальный вызов типа такого:
Draw(-13,0,13,0,7);
Успехов тебе.

[TinMan]

(Извиняюсь за мультипостинг, но мне кажется, что лучше отделить)

Картинка фрактала мне в целом понравилась, но все же ей не хватает цветности. Я некоторое время думал, как бы тут привлечь цвет.. Глубина не пойдет, поскольку все, что рисуется - рисуется на максимальной глубине. Так что я решил так: горизонтальные участки (плечи)) одного цвета, вертикальные (шея) - другого, а косая палка (башка)) - третьего. И вот, что вышло:



Картинка не совсем точна - похоже, движок форума ее уменьшил..
Есть у кого-нить другие идеи цветности? ))

Да, вот код (начиная с процедуры Draw и до конца)

...
procedure Draw(x1, y1, x2, y2: real; n,c: integer);
var
  dx, dy: real;
begin
  if n=0 then begin
    SetColor(c);
    Line(round((x1-u1)*S),GetMaxY-round((y1-v1)*S),round((x2-u1)*S),GetMaxY-round((y2-v1)*S))
  end
  else begin
    dx:=(x2-x1)/3;
    dy:=(y2-y1)/3;
    draw(x1,y1,x1+dx,y1+dy,n-1,LightBlue);
    draw(x1+dx,y1+dy,x1+dx+dy,y1+dy-dx,n-1,Cyan);
    draw(x1+dx+dy,y1+dy-dx,x2-dx-dy,y2-dy+dx,n-1,White);
    draw(x2-dx-dy,y2-dy+dx,x2-dx,y2-dy,n-1,Cyan);
    draw(x2-dx,y2-dy,x2,y2,n-1,LightBlue);
  end
end;

begin
  Init;
  Draw(-13,-1,13,1,7,0);
  ReadKey;
  CloseGraph;
end.

[marat-link]

Спасибо TinMan'у за помощь в построении фрактала! Цветность для меня не столь важна, как сам алгоритм построения. Но всё же наблюдать за построением цветного фрактала куда интереснее, чем за "сухим" белым Благодарю TinMan за потраченное на меня время!

[ukna]

Добрый день. Подскажите вы еще занимаетесь фракталам. Вопрос такой, надо
построить фрактал и рассчитать фрактальную размерность по фото пористого
тела. Такое возможно? или просто подскажите с чего начать какой алгоритм,
естественно не в ручной обработки а программкой какой нибудь? такое
возможно?

если можно ответ на почту kna007@sibmail.com или аська 361345603