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
|
