Тайна конопли 2 или (R = (1+sin(t))*(1-.9*abs(sin(4*t)))*(.9+.05*cos(200*t)))

[HolyDel]

Ничего не делать мы не можем по определению. Поэтому программеры страдают всякой хней, и пишут всякие прикольные програмки. Вот мне седня попалась интересная формула: R = (1+sin(t))*(1-.9*abs(sin(4*t)))*(.9+.05*cos(200*t))

а вот что получилось:
http://www.forum.likosoft.ru/attachment.ph...mp;d=1217939920

на генерацию "рисунка", точнее на его заблюривание, на моем "пентиуме" окола 5 секунд.

Graphics3D 800,600,32,2
SetBuffer FrontBuffer()
t#=0
Dim pixmap(0,0)

Color 92,192,0
steps = 0

While(steps<50)
	;Rect(0,0,512,512,0)
	t=t+0.2618;

	R# = (1+Sin(t))*(1-.9*Abs(Sin(4*t)))*(.9+.05*Cos(200*t))
	
	x# = 256 + Sin(t-90) * r*(220-(steps*4))
	y# = 450 - Cos(t-90) * r*(230-(steps*4))
	
	
	If ox=0 Then ox=x
	If oy=0 Then oy=y
	Line x,y,ox,oy
	ox=x
	oy=y
	
	If t>360
		t=0
		steps=steps+1
		ox=0
		oy=0
		Delay(1)
	EndIf
;	Delay(1)
Wend

tex = CreateTexture(512,512)
CopyRect(0,0,512,512,0,0,FrontBuffer(),TextureBuffer(tex))

buff=TextureBuffer(tex)
;LockBuffer buff
BlurBuffer(buff,512,512,2)

;UnlockBuffer buff
q = CreateQuad()
HideEntity q
EntityTexture q,tex
EntityBlend q,3
ScaleEntity q,5,5,5

SetBuffer BackBuffer()

cam = CreateCamera()

Type plan
	Field ent,x#,y#,z#
	Field dx#,dy#,dz#
	Field tx#,ty#
End Type

PositionEntity cam,0,10,-20
PointEntity cam,q

While Not KeyDown(1)
	AddPlan(q)
	UpdatePlans()
	RenderWorld
	Flip
Wend

Function CreateQuad()
	quad=CreateMesh()
	s=CreateSurface(quad)
	v0=AddVertex(s,-1,0,1,0,0)
	v1=AddVertex(s,1,0,1,0,1)
	v2=AddVertex(s,1,0,-1,1,1)
	v3=AddVertex(s,-1,0,-1,1,0)
	AddTriangle(s,v0,v1,v2)
	AddTriangle(s,v0,v2,v3)
	Return quad
End Function

Function AddPlan(ent)
	p.plan = New plan
	p\ent = CopyEntity(ent)
	ShowEntity p\ent
	EntityFX p\ent,1+16
	p\dx=Rnd(-0.5,0.5)
	p\dz=Rnd(-0.5,0.5)
	p\dy=Rnd(0.5,1)
	p\tx=Rnd(-2,2)
	p\ty=Rnd(-5,5)
End Function

Function UpdatePlans()
	For p.plan = Each plan
		TurnEntity p\ent,p\tx,0,0
		TurnEntity p\ent,0,p\ty,0
		
		p\dx=p\dx*0.99
		p\dz=p\dz*0.99
		
		p\dy=p\dy-0.02
		
		TranslateEntity p\ent,p\dx,p\dy,p\dz
		If EntityY(p\ent)<-100
			FreeEntity p\ent
			Delete p
		EndIf
	Next
End Function

Function Paint(buff,x,y,clr,maxw,maxh)

	WritePixel(x,y,clr,buff)
	For di=-1 To 1
		For dj=-1 To 1
			cx = x+di
			cy = y+dj
			If cx>=0 And cy>=0 And cx<maxw And cy<maxh
			    cc = ReadPixelFast(cx,cy,buff) And $00FFFFFF
			    ;DebugLog cc
				If cc=0
					Paint(buff,cx,cy,clr,maxw,maxh)
				EndIf
			EndIf
		Next
	Next
	
End Function

Function PaintFast(buff,x,y,clr,maxw,maxh)

	WritePixelFast(x,y,clr,buff)
	For di=-1 To 1
		For dj=-1 To 1
			cx = x+di
			cy = y+dj
			If cx>=0 And cy>=0 And cx<maxw And cy<maxh
			    cc = ReadPixelFast(cx,cy,buff) And $00FFFFFF
			    ;DebugLog cc
				If cc=0
					PaintFast(buff,cx,cy,clr,maxw,maxh)
				EndIf
			EndIf
		Next
	Next
	
End Function

Function RGB(r,g,b)
Return r Shl 16 Or g Shl 8 Or b
End Function

Function BlurBuffer(buff,width,height,strenght)

	Dim pixmap(width,height)
	
	For i=0 To width-1
		For j=0 To height-1	
			pixmap(i,j)=ReadPixel(i,j,buff)	
		Next
	Next
	
	For i=0 To width-1
		For j=0 To height-1
			cnt=0
			r=0
			g=0
			b=0
			For di=-strenght To strenght
				For dj=-strenght To strenght
					ci = i+di
					cj = j+dj
					
					If ci>=0 And ci<width And cj>=0 And cj<=height
						c = pixmap(ci,cj)
						r=r+RGBR(c)
						g=g+RGBG(c)
						b=b+RGBB(c)
						cnt=cnt+1
					EndIf
				Next
			Next
			
			WritePixel(i,j,RGB(r/cnt,g/cnt,b/cnt),buff)
		Next
	Next
	
End Function

Function RGBR(v)
	Return (v Shr 16) And $FF
End Function

Function RGBG(v)
	Return (v Shr 8) And $FF
End Function

Function RGBB(v)
	Return v And $FF
End Function

[ABTOMAT]

АХАХАХ жжош нереально

Кстати:


x# = 256 + Sin(t-90) * r*(220-(steps*4))
y# = 450 - Cos(t-90) * r*(230-(steps*4))


Синус альфа + 90 = косинус альфа
Косинус альфа + 90 = синус альфа

то есть этот же код можно математически оптимизировать:

x# = 256 + Cos(t) * r*(220-(steps*4))
y# = 450 - Sin(t) * r*(230-(steps*4))

[ffinder]

жжош камрад.

[dimanche13]

боян

[Android]

ЖЕСТЬ! +1 )))

[newman]

Сообщение от dimanche13

боян

+1

Вроде бы на булке это уже выкладывали... Но это лучше

[Tadeus]

Сообщение от newman

+1

Вроде бы на булке это уже выкладывали... Но это лучше

Холег и выкладывал

[HolyDel]

я искал свою тему! но не нашел. она пропала. это все происки минздрава.

[Tadeus]

Сообщение от HolyDel

я искал свою тему! но не нашел. она пропала. это все происки минздрава.

Неужто и туда масоны пробрались? О_О

[ABTOMAT]

Да-да-да, это масоны и они мешают нам разводить коноплю!

[tormoz]

На улице лето - пляж, пиво, девачки, а оне тут хформулы выводять...
Вот будете старые и больные - ишшо вспомните и будете волосы на жопе рвать, за бесцельно упущенные сиськи )

[newman]

tormoz, а надо просто научиться совмещать .... Только вот не получается

[ABTOMAT]

До бесцельно упущенных сисек ещё добраться нужно, а это уметь надо

[HolyDel]

На улице лето - пляж, пиво, девачки, а оне тут хформулы выводять...

ы.. город, серость, слякоть, дожди.

Вот будете старые и больные - ишшо вспомните и будете волосы на жопе рвать, за бесцельно упущенные сиськи )

будем, причем при любом раскладе )))

[Spiderman]

А если заменить первые строки на такую комбинацию латиницы, то будет сердце:

Graphics3D 800,600,32,2
SetBuffer FrontBuffer()
t#=0
Dim pixmap(0,0)

Color 192,2,2
steps = 0

While(steps<50)
	t=t+0.2618;
      
      R# = (1+Sin(t))*(2-.2*Abs(Cos(d*t+t)))*(.2-.01*ATan(200*t)+.2)
		
	x# = 400 + Sin(t-90) * r*(220-(steps*4))
	y# = 100 - Cos(t-90) * r*(230-(steps*4))