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

Рисование папоротника с помощью фракталов



1k 
 

Hello Mike! VK>> Так вот . Все это очень здорово и можно помучиться со всем этим, VK>> но может кто-нибудь уже.. Хотелось :( бы увидеть реальную работу VK>> всей этой кухни, хотя для треугольника Сьерпинского алгоритм у VK>> меня есть, но это совсем не то. А вот с листом (АБАЛДEHHЫЙ 8O ) VK>> папоротника - шо-то мудренное или я торможу. Да ничего оказывается мудренного. Привожу программку, она такая маленькая что даже удивительно что она может что нибудь нарисовать. Она была опубликована в PC Magazine, на бейсике. Hу я перевел короче. Кстати сама статья где она публиковалась именно посвящена тому какая это круть фрактальные алгоритмы и как же они устроены. Hу и обьяснение ограничивается глубокомысленным рассуждением о том что вот смотрите какая простая программка рисует такую сложную картинку и значит как легко можно сжать подобную картинку если она встретится в реальности. Hу и выплывают коэфициенты сжатия в 500 раз. Меня разумеется такие доводы совершенно ни в чем не убедили, но картинка действительно красивая. Aziz --- GoldED 2.40+ * Origin: Happiness is a warm gun (2:5085/13.11) {> Cut here. FileName= FRACT.PAS } { Фрактальные структуры и программка для папоротника! } {-----------------------------------------------------} program Fract; { remaked by A.Saidrasulov } uses Graph,Crt; var Dt,M : integer; R,A,B,C,D,E,F, NewY,NewX,X,Y : real; begin Dt := Detect; InitGraph(Dt, M,''); Randomize; X := 0; Y := 0; repeat R := Random; if R>0.93 then begin A := -0.15; B := 0.28; C := 0.26; D := 0.24; E := 0; F := 0.44; end else if R>0.86 then begin A := 0.2; B := -0.26; C := 0.23; D := 0.23; E := 0; F := 1.6; end else if R>0.01 then begin A := 0.85; B := 0.02; C := -0.02; D := 0.85; E := 0; F := 1.6; end else begin A := 0; B := 0; C := 0; D := 0.16; E := 0; F := 0; end; NewX := A*X + B*Y + E; NewY := C*X + D*Y + F; X := NewX; Y := NewY; PutPixel(Round(X*50)+100,Round(Y*50)+50, Green); until(Keypressed); CloseGraph; end.