Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   forum.boolean.name > Программирование игр для мобильных телефонов > MidletPascal > Наше Open Source Software

Наше Open Source Software Наработки для использования в Ваших проектах

Ответ
 
Опции темы
Старый 19.10.2011, 22:13   #1
Igor
Мастер
 
Аватар для Igor
 
Регистрация: 03.05.2010
Адрес: Подмосковье
Сообщений: 1,218
Написано 438 полезных сообщений
(для 790 пользователей)
Фрактал:"Кривая дракона"

Википедия
там есть пример на делфи, но код писался до прочтения той статьи)

суть:
1)изначально кривая является отрезком.
2)берём кривую за крайнюю точку, копируем относительно её с поворотом на 90. результат в два раза длиннее) Повторить много раз.

мой код:
program Dragon;

//кусочек кривой, х и у - смещение относительно предыдущей точки
type
kus=record
x,y:integer;
end;

var line:array[1..10000] of kus;

//поворачивает кривую от 1 до а, добавляет её с (а+1) до 2*а
procedure povorot(a:integer);
var i:integer;
begin
for i:=1 to a do
begin
line[i+a].x:=Line[a-i+1].y;
line[i+a].y:=-Line[a-i+1].x;
end;
end;


procedure CreateStartline;
begin

line[1].x:=1;
end;

//рисуем кривую, num - количество рисуемых звеньев
procedure LineDraw(scale,num:integer);
var i,x,y:integer;
begin
setcolor(0,0,0);
x:=getwidth div 2;
y:=getheight div 2;
for i:=1 to num do
begin
drawLine(x,y,x+Line[i].x*scale,y+Line[i].y*scale);
x:=x+Line[i].x*scale;
y:=y+Line[i].y*scale;
end;
end;

//ждём нажатия любой клавиши
procedure wait;
begin

repeat
delay(50);
until getkeypressed<>ke_none;
end;

//рисует всё
procedure Draw(num:integer);
begin

setcolor(255,255,255);
fillrect(0,0,getwidth,getheight);
LineDraw(4,num);
repaint;
end;

procedure main;
var L:integer;
begin
CreateStartLine;
l:=1;
repeat
Draw(L);
povorot(L);

l:=l*2;
Delay(1000);
until L>10000;
wait;
end;

begin
main;
end
.


реализация алгоритма из википедии. Довольно забавно строит кривую - не по порядку, и при её увеличении меняет её всю (предыдущий алгоритм достраивает с краю)

program DragonWiki;

procedure Dragon(x1,y1,x2,y2,k:integer);
var tx,ty:integer;
begin
if k=0 then
begin
DrawLine(x1,y1,x2,y2);
repaint;
end
else
begin
tx:=(x1+x2) div 2+(y2-y1) div 2;
ty:=(y1+y2) div 2-(x2-x1) div 2;
Dragon(x2,y2,tx,ty,k-1);
Dragon(x1,y1,tx,ty,k-1);
end;
end;


procedure main;
begin
setcolor(255,255,255);
fillrect(0,0,getwidth,getheight);
setcolor(0,0,0);
Dragon(50,50,50+128,50+128,13);
Delay(100)
end;

begin
main;
end.

Второй алгоритм намного короче, не использует массив, но для него нужно указать хорошие начальную и конечные точки. Есть куда стремиться)
Миниатюры
Нажмите на изображение для увеличения
Название: fr.jpeg
Просмотров: 1438
Размер:	26.0 Кб
ID:	15161  
__________________
О¯О ¡¡¡ʁɔvʎнdǝʚǝdǝu dиW

Последний раз редактировалось Igor, 24.10.2011 в 23:22.
(Offline)
 
Ответить с цитированием
Эти 4 пользователя(ей) сказали Спасибо Igor за это полезное сообщение:
ProFessor_nic (09.07.2012), Romanzes (20.10.2011), SBJoker (19.10.2011), scimitar (05.01.2012)
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +4, время: 06:55.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com