|
PureBasic Мощный кросс-платформенный язык среднего уровня на основе BASIC. Подходит для решения широкого круга задач. |
25.01.2007, 21:17
|
#1
|
|
Fractals
Последнее время я что-то увлеклась фрактальной графикой... Больно уж мне импонирует сама идея создания сложных узоров всего из одной формулы. Так вот, для тех, кто также желает познакомиться с фракталами, публикую небольшой шаблончик:
InitSprite()
OpenWindow(0, 0, 0, 800, 600, "--Fractal Test--", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
Define Width = WindowWidth(0) - 1, Height = WindowHeight(0) - 1, X, Y
OpenWindowedScreen(WindowID(0), 0, 0, Width + 1, Height + 1, #False, 0, 0)
StartDrawing(ScreenOutput())
For X = 0 To Width
For Y = 0 To Height
;--Fractal[--;
; Insert your fractal formula here !
;--]Fractal--;
Next Y
Next X
StopDrawing()
While WaitWindowEvent() <> #PB_Event_CloseWindow
Wend
Некоторые хорошие замены строке "; Insert your fractal formula here" :
;=-----------------------------------------------------=
Plot(X, Y, Pow((X * 3), Sin(Y) * Cos(X)) / Y+X * Y+X)
;=-----------------------------------------------------=
V.C = (X ! ~Y) * ~11000 - Y*~X
Plot(X, Y, RGB(V, V, V))
;=-----------------------------------------------------=
Plot(X, Y, Pow(Cos(X) / Sin(Y), Sqr(X*Y)+10000000))
;(Впечатляет не очень, но эффект интересный)
;=-----------------------------------------------------=
Да, если найдете еще какие интересные формулы - пишите, составим коллекцию !
|
|
|
26.01.2007, 00:54
|
#2
|
Зануда с интернетом
Регистрация: 04.09.2005
Сообщений: 14,014
Написано 6,798 полезных сообщений (для 20,935 пользователей)
|
Re: Fractals
__________________
http://nabatchikov.com
Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz
А я растила сына на преданьях
о принцах, троллях, потайных свиданьях,
погонях, похищениях невест.
Да кто же знал, что сказка душу съест?
|
(Offline)
|
|
26.01.2007, 10:50
|
#4
|
Оператор ЭВМ
Регистрация: 10.01.2007
Сообщений: 37
Написано 6 полезных сообщений (для 5 пользователей)
|
Re: Fractals
Данный код рисует изображение множества Мандельброта. В общем ни чего особенного, но интересно поиграться - если кликнуть мышкой в левый верхний угол предполагаемого прямоугольника, а
потом в правый нижний угол этого же прямоугольника, то он выделиться и нажать на кнопку "Построить", то будет построена увеличенная копия этого места. Так можно повторить несколько раз, получая каждый раз новые интересные узоры.
А ещё текущая картинка сохраняется в BMP
;{ К сожалению не могу указать настоящего автора, но что то было по немецки и для V3.92
; Я только не много подкорректировал и привёл к V4.0
;
;}
InitSprite()
Global m, n, zaehler
Global aktx1,akty1,aktx2,akty2
Define.f
Global seite, spalt, t
Global ecke_im, ecke_re, c_im, c_re, z_im, z_re
Define.l
hwnd=OpenWindow(1,0,0,800,500,"Mandelbrot",#PB_Window_SystemMenu|#PB_Window_WindowCentered)
OpenWindowedScreen(WindowID(1),0,0,500,500,0,0,0)
CreateGadgetList(WindowID(1))
TextGadget(20,510,10,130,20,"Разрешение (пиксел):")
StringGadget(1,650,10,140,20,"500",#PB_String_Numeric)
ButtonGadget(2,510,40,60,20,"Построить")
ButtonGadget(6,650,40,140,20,"Новое разрешение")
TextGadget(21,510,70,90,20,"Размер :")
StringGadget(3,650,70,140,20,"2.5")
TextGadget(22,510,100,130,20,"Действительная ось:")
StringGadget(4,650,100,140,20,"-2.0")
TextGadget(23,510,130,130,20,"Мнимая ось:")
StringGadget(5,650,130,140,20,"-1.25")
TextGadget(24,650,230,130,20," ")
Repeat
anzFelder=Val(GetGadgetText(1))
aktseite.f=ValF(GetGadgetText(3))
aktre.f=ValF(GetGadgetText(4))
aktim.f=ValF(GetGadgetText(5))
UpdateWindow_(WindowID(1))
Repeat
ClearScreen(RGB(0,0,0))
event=WindowEvent()
If event = 0
Delay(10)
EndIf
If event=#PB_Event_Gadget
Select EventGadget()
Case 2
anzFelder=Val(GetGadgetText(1))
seite=ValF(GetGadgetText(3))
spalt=seite/anzFelder
ecke_re=ValF(GetGadgetText(4))
ecke_im=ValF(GetGadgetText(5))
Break
Case 6
anzFelder=Val(GetGadgetText(1))
seite=aktseite
spalt=seite/anzFelder
ecke_re=aktre
ecke_im=aktim
Break
EndSelect
EndIf
If image
StartDrawing(ScreenOutput())
DrawImage(ImageID(1),0,0,500,500)
StopDrawing()
EndIf
winx=WindowMouseX(1)
winy=WindowMouseY(1)
If gedr=0 And GetAsyncKeyState_(#VK_LBUTTON)
If winx<500 And winx>0 And winy<500 And winy>0
aktx1=WindowMouseX(1)
akty1=WindowMouseY(1)
gedr=1
aktx2=0
akty2=0
Repeat
Until GetAsyncKeyState_(#VK_LBUTTON)=0
EndIf
ElseIf gedr=1 And GetAsyncKeyState_(#VK_LBUTTON)
If winx<500 And winx>0 And winy<500 And winy>0
aktx2=WindowMouseX(1)
akty2=WindowMouseY(1)
gedr=0
seit.f=aktseite/(500/Abs(aktx2-aktx1))
re.f=aktre+(aktseite/(500/aktx1))
im.f=aktim+(aktseite/(500/akty1))
SetGadgetText(4,StrF(re)) ;re
SetGadgetText(5,StrF(im)) ;im
SetGadgetText(3,StrF(seit)) ;seite
Repeat
Until GetAsyncKeyState_(#VK_LBUTTON)=0
EndIf
EndIf
StartDrawing(ScreenOutput())
If aktx1 And akty1 And aktx2 And akty2
DrawingMode(4)
Box(aktx1,akty1,aktx2-aktx1,akty2-akty1,$FF0000)
EndIf
StopDrawing()
FlipBuffers()
Until event=#PB_Event_CloseWindow
If event=#PB_Event_CloseWindow
End
EndIf
CreateImage(1,anzFelder,anzFelder)
StartDrawing(ImageOutput(1))
;Расчет
For n= 1 To anzFelder
For m= 1 To anzFelder
c_re=ecke_re+n*spalt
c_im=ecke_im+m*spalt
z_re=0
z_im=0
zaehler=0
Repeat
t=2*z_re*z_im+c_im
z_re=z_re*z_re-z_im*z_im+c_re
z_im=t
zaehler=zaehler+1
Until zaehler>1000 Or (z_im*z_im+z_re*z_re)>4
;Рисуем в цвете
If zaehler>1000
Plot(n,m,0)
Else
Plot(n,m,zaehler*1677)
EndIf
Next
SetGadgetText(24, "Идёт построение ...")
Next
StopDrawing()
SetGadgetText(24, " ")
SaveImage(1,"Mandelbrot.bmp",#PB_ImagePlugin_BMP)
image=1
ForEver
|
(Offline)
|
|
26.01.2007, 11:56
|
#5
|
|
Re: Fractals
Эх, а я тут еще одну забавную формулу для своей проги нашла :
V.C = Pow(X+y, 2)
Plot(X, Y, V)
|
|
|
26.01.2007, 19:21
|
#6
|
Элита
Регистрация: 02.10.2005
Сообщений: 1,789
Написано 132 полезных сообщений (для 252 пользователей)
|
Re: Fractals
V.C = Pow(X+y*10, 2)
Plot(X, Y, V)
V.C = Pow(X+y*12, 2)
Plot(X, Y, V)
V.C = Pow(Sqr(x+y), 2)
Plot(X, Y, V)
V.C = Pow((x-400)*(x-400)+(y-300)*(y-300), 2)
Plot(X, Y, V)
видоизменил код.
последний эффект ваще отжоговый
|
(Offline)
|
|
26.01.2007, 19:32
|
#7
|
Элита
Регистрация: 02.10.2005
Сообщений: 1,789
Написано 132 полезных сообщений (для 252 пользователей)
|
Re: Fractals
крест
V.C = Pow((x-400)*(x-400)+(y-300)*(y-300), 2)
Plot(X, Y, V)
похоже на двойную гиперболу(ветви - вверх, вниз, влево, вправо) закращенная внутрях
V.C = Pow((x-400)*(x-400)-(y-300)*(y-300), 2)
Plot(X, Y, V)
V.C = Pow(Sqr((x-400)*(x-400)+(y-300)*(y-300)), 2)
Plot(X, Y, V)
V.C = Pow(Sqr((x-400)*(x-400)-(y-300)*(y-300)), 2)
Plot(X, Y, V)
ищо
V.C = Pow(Sqr((x-400)*(x-400)*(y-300)*(y-300)), 2)
Plot(X, Y, V)
ого скока комбо можно вывести ещё!
p.s.в аттаче ещё
|
(Offline)
|
|
26.01.2007, 20:10
|
#8
|
|
Re: Fractals
Симпатичный узорчик :
V = Tan(Sin(X)+Cos(Y))*30
Plot(X, Y, V)
|
|
|
26.01.2007, 20:14
|
#9
|
Элита
Регистрация: 02.10.2005
Сообщений: 1,789
Написано 132 полезных сообщений (для 252 пользователей)
|
Re: Fractals
V =Tan(Sin(X*y)+Cos(Y*x))*70
а как такой?
|
(Offline)
|
|
26.01.2007, 20:29
|
#10
|
|
Re: Fractals
Сообщение от ZanoZa
V =Tan(Sin(X*y)+Cos(Y*x))*70
а как такой?
|
Прикольно . А вот еще лучше:
V = ~X*~Y
V = Tan(V)*8
Plot(X, Y, V)
|
|
|
26.01.2007, 20:40
|
#11
|
Элита
Регистрация: 02.10.2005
Сообщений: 1,789
Написано 132 полезных сообщений (для 252 пользователей)
|
Re: Fractals
ооо ваще круть!
тока я не догоняю зачем ~X ~Y?
V = (x*(x+100)+y*(y+100))
дождь
V = (x*(x+400)+y*(y+300))*Sin(x+y)
|
(Offline)
|
|
26.01.2007, 20:43
|
#12
|
|
Re: Fractals
тока я не догоняю зачем ~X ~Y?
|
Символ '~' - это Bitwise NOT в пурике.
|
|
|
26.01.2007, 21:04
|
#13
|
Элита
Регистрация: 02.10.2005
Сообщений: 1,789
Написано 132 полезных сообщений (для 252 пользователей)
|
Re: Fractals
то есть не X и не Y? есди да, то что это даёт?
|
(Offline)
|
|
26.01.2007, 21:32
|
#14
|
|
Re: Fractals
Нет.
есди да, то что это даёт?
|
Это дает значения X и Y с инвертированными битами.
|
|
|
26.01.2007, 22:15
|
#15
|
Элита
Регистрация: 02.10.2005
Сообщений: 1,789
Написано 132 полезных сообщений (для 252 пользователей)
|
Re: Fractals
понятно
|
(Offline)
|
|
Ваши права в разделе
|
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
|
|
|
Часовой пояс GMT +4, время: 01:33.
|