Procedural dynamic textures

My simple "perlin-noise" generator

;2-óðîâíåâûé ãåíåðàòîð øóìà Ïåðëèíà (ïî÷òè)
;äëÿ óïðîùåíèÿ è óñêîðåíèÿ èñïîëüçóåòñÿ ðåíäåð âèäþõè
;ñîçäàííàÿ òåêñòóðà ìîæåò ãåíåðèòüñÿ "áåñøîâíîé" ïî ãîðèçîíòàëè è âåðòèêàëè


Global GW=1280
Global GH=1024

Graphics3D GW,GH,0,1
Global cam=CreateCamera()
SetFont LoadFont ("",15)
Dim s(100)
Dim t(100)
Dim sp(100)


tx=CreateTexture(GH,GH,1)
i=0
sp(i)=CreateQuad()
EntityFX sp(i),1+8+16
EntityOrder sp(i),-i
PositionEntity sp(i),0,0,Float(GW)/Float(GH)
EntityTexture sp(i),tx

.loop
	r0=Rand(9,10)
	r1=Rand(0,5)
	Generate r0,r1,tx,1,1
	AutoContrast 1,tx		;ôèëüòð àâòîêîíòðàñòíîñòè ñ óïðàâëÿåìûì ïîðîãîì "÷åðíîãî"
	RenderWorld
	Text 10,10,"Base Freq: "+Str(r0)
	Text 10,25,"Modulate Freq: "+Str(r1)
	Text 10,40,"G - new generate"
	Flip 0
	k=WaitKey()
	If k=103 Then Goto loop
End




;iq - ÷àñòîòà ãåíåðàöèè îñíîâíîãî àääèòèâíîãî øóìà (âñå ÷àñòîòíûå ñîñòàâëÿþùèå ÑÊËÀÄÛÂÀÞÒÑß)
;iq = 2 ... 10 (1024 pix)

;iq0 - ÷àñòîòà ãåíåðàöèè ìîäóëÿöèîííîãî øóìà (øóì iq ÓÌÍÎÆÀÅÒÑß íà øóì iq0)
;åñëè iq0<1 òî íåãåíåðèòüñÿ
;ìíîé èñïîëüçîâàí äëÿ ãåíåðàöèè íèçêî÷àñòîòíûõ ìîäóëÿöèé îñíîâíîãî øóìà - "îáëàêîâ"

;tt - òåêñòóðíûé áóôôåð, êóäà áóäåò ïîìåùåíà ñãåíåðåííûé øóì

;lpX è lpY - ôëàãè "áåñøîâíîñòè" ïî îñÿõ X è Y

;ðàçìåð òåêñòóðû ãåíåðÿùåéñÿ òåêñòóðû = 2^iq (2^iq0), òàêæå çàâèñèò îò âèäåîðàçðåøåíèÿ
;è âîîáùå âîçìîæíîñòåé âèäåîêàðòû

Function Generate(iq,iq0,tt,lpX=0,lpY=0)
	RotateEntity cam,0,180,0
	CameraClsColor cam,0,0,0

	SeedRnd MilliSecs ()

	For i=2 To iq
		s(i)=CreateQuad()
		EntityFX s(i),1+8+16
		EntityOrder s(i),-i
		PositionEntity s(i),0,0,-Float(GW)/Float(GH)
		EntityAlpha s(i),1.0/Float(iq)
		EntityBlend s(i),3
		
		d=2^i
		t(i)=CreateTexture (d,d,1)
		b=TextureBuffer( t(i) )
		SetBuffer b
		LockBuffer b
		For x=0 To d-1
			For y=0 To d-1
				c=Rand(0,255)
				WritePixelFast x,y,(c Shl 16)+(c Shl 8)+c
			Next
		Next
		
		If lpX>0 Then
		For y=0 To d-1				;áåñøîâíîñòü ïî ãîðèçîíòàëè
			c=ReadPixelFast (0,y)
			WritePixelFast d-1,y,c
		Next
		EndIf
		If lpY>0 Then
		For x=0 To d-1				;áåñøîâíîñòü ïî âåðòèêàëè
			c=ReadPixelFast (x,0)
			WritePixelFast x,d-1,c
		Next
		EndIf
		
		UnlockBuffer b

		kk#=Float(d)/Float(d-1)
		ScaleEntity s(i),kk,1.0,1.0
		EntityTexture s(i),t(i)
	Next

	SeedRnd MilliSecs ()
	
	If iq0>0 Then
	For i=1 To iq0
		i0=iq+i
		
		s(i0)=CreateQuad()
		EntityFX s(i0),1+8+16
		EntityOrder s(i0),-i0
		PositionEntity s(i0),0,0,-Float(GW)/Float(GH)
		EntityBlend s(i0),2
		
		d=2^i
		t(i0)=CreateTexture (d,d,1)
		b=TextureBuffer( t(i0) )
		SetBuffer b
		LockBuffer b
		For x=0 To d-1
			For y=0 To d-1
				c=Rand(128,255)
				WritePixelFast x,y,(c Shl 16)+(c Shl 8)+c
			Next
		Next
		
		If lpX>0 Then
		For y=0 To d-1				;áåñøîâíîñòü ïî ãîðèçîíòàëè
			c=ReadPixelFast (0,y)
			WritePixelFast d-1,y,c
		Next
		EndIf
		If lpY>0 Then
		For x=0 To d-1				;áåñøîâíîñòü ïî âåðòèêàëè
			c=ReadPixelFast (x,0)
			WritePixelFast x,d-1,c
		Next
		EndIf
		UnlockBuffer b
		
		kk#=Float(d)/Float(d-1)
		ScaleEntity s(i0),kk,1.0,1.0
		EntityTexture s(i0),t(i0)
	Next
	EndIf


	SetBuffer BackBuffer()
	RenderWorld


	d=GH
	dx=(GW-GH)/2
	CopyRect dx,0,d,d,0,0,BackBuffer(),TextureBuffer(tt)


	For i=2 To (iq+iq0)
		FreeEntity s(i)
		FreeTexture t(i)
	Next
	RotateEntity cam,0,0,0

End Function

Function AutoContrast(lev,tx)
	min=255
	max=0
	b=TextureBuffer (tx)
	SetBuffer b
	LockBuffer b
	
	For x=0 To GH-1
		For y=0 To GH-1
			c=ReadPixelFast (x,y) And 255
			If c>max Then max=c
			If c<min Then min=c
		Next
	Next

	min=min+lev
	max=max-lev
	k#=255.0/Float(max-min)
	
	For x=0 To GH-1
		For y=0 To GH-1
			c=ReadPixelFast (x,y) And 255
			
			cm=c-min
			If cm<0 Then cm=0
			
			c0=(Float(cm)*k)
			If c0>255 Then c0=255
			
			WritePixelFast x,y,(c0 Shl 16)+(c0 Shl 8)+c0
		Next
	Next

	UnlockBuffer b
	SetBuffer BackBuffer()
End Function

Function CreateQuad()
	m=CreateMesh()
	sf=CreateSurface(m)

	v0=AddVertex(sf, -1.0,1.0,0.0, 0.0,0.0)
	v1=AddVertex(sf, 1.0,1.0,0.0, 1.0,0.0)
	v2=AddVertex(sf, 1.0,-1.0,0.0, 1.0,1.0)
	v3=AddVertex(sf, -1.0,-1.0,0.0, 0.0,1.0)

	AddTriangle sf,v0,v1,v2
	AddTriangle sf,v0,v2,v3
	
	Return m
End Function