блин . . вчерась поздно было . . .дико звиняюсь . . .
тут фишка что пламя само по себе горит . . его просчитывать ненуна. . .
создал и фсё. . .(если кому интерестно стучитесь в асю)
;BOPOH / red_kapcap icq 212602917
;DEMO_Fire
Graphics3D 800,600,16,2
Const SyncTime=30
Global sync=CreateTimer(SyncTime)
Global oldtime=0
Global fps#=SyncTime
SeedRnd MilliSecs()
AmbientLight 100,100,100
Global light_amb=CreateLight():RotateEntity(light_amb,80,-20,0)
plane=CreatePlane():EntityTexture plane,MakeTx_001()
SetBuffer BackBuffer()
Global GLTarget=CreatePivot()
Global Camera=CreateCamera(GLTarget):CameraClsColor Camera,200,170,200
MoveEntity Camera,0,2,-15:PointEntity camera,GLTarget
;;=================ini
Global GlobalFireTexture=FireTexture(1) ; 1 or 2
For ix=0 To 50
e=CreateNewFire(1,1,Rnd(1,2)):PositionEntity e,Rnd(-10,10),0,Rnd(-10,10)
Next
tExit=False
;===================================================
While Not tExit
SoftFPS#()
If KeyDown( 1 ) tExit=True
TurnEntity GLTarget,0,0.2,0
If fps>=SyncTime e=CreateNewFire(1,1,Rnd(1,2)):PositionEntity e,Rnd(-10,10),0,Rnd(-10,10)
SetBuffer BackBuffer()
UpdateWorld ()
RenderWorld
Color 255,10,10
Text 0,0,"FPS="+RSet$(Str(FPS#),6) +" Triangles Rendered: "+RSet$(TrisRendered(),10)
WaitTimer(Sync)
Flip
Wend
;-----------------------------------------\\\
Function SoftFPS#()
fps#=1000/(MilliSecs()-oldtime)
oldtime=MilliSecs()
;Return fps#
End Function
;-----------------------------------------///
;==================================================
Function CreateNewFire(Size=1,wt=1,ht=2)
ent0=CreatePivot()
tx=GlobalFireTexture
;FireTexture(Size)
ent=firemesh(wt,Ht,ent0)
;ent=Co3gamb3DPlaneC0(3,3)
EntityTexture ent,tx
EntityBlend ent,3
EntityFX ent,17
;---------------anim
SetAnimKey ent,0,0,1
SetAnimKey ent,1,0,1
TurnEntity ent,0,90,0
SetAnimKey ent,2,0,1
SetAnimKey ent,3,0,1
TurnEntity ent,0,90,0
SetAnimKey ent,4,0,1
SetAnimKey ent,5,0,1
TurnEntity ent,0,90,0
SetAnimKey ent,6,0,1
SetAnimKey ent,7,0,1
AddAnimSeq ent,8
Animate ent
;-----------------------
ent1=firemesh(wt,Ht*0.6,ent0)
EntityTexture ent1,tx
EntityBlend ent1,3
EntityFX ent1,16
RotateMesh ent1,0,45,0
SetAnimKey ent1,0,0,1
SetAnimKey ent1,1,0,1
TurnEntity ent1,0,-90,0
SetAnimKey ent1,2,0,1
SetAnimKey ent1,3,0,1
TurnEntity ent1,0,-90,0
SetAnimKey ent1,4,0,1
SetAnimKey ent1,5,0,1
TurnEntity ent1,0,-90,0
SetAnimKey ent1,6,0,1
SetAnimKey ent1,7,0,1
AddAnimSeq ent1,8
Animate ent1
ScaleEntity ent0,0.01,0.01,0.01
SetAnimKey ent0,0,0,0,1
frames=160
For ix=1 To frames Step 15
k#=Rnd(-0.2,0.3)
SetAnimKey ent0,ix,0,0,1
ScaleEntity ent0,1+k*0.5,1+k#,1+k*0.5
Next
frames=frames+10
ScaleEntity ent0,0.01,0.01,0.01
SetAnimKey ent0,frames,0,0,1
AddAnimSeq ent0,frames+10
Animate ent0
Return ent0
End Function
;------------------------------------------------------------------------------------------------------------
Function FireTexture(Size=1)
Local x#,y#,strn%,kadr%,col%
Local w#,h#
sz=16 Shl size
strn=(sz*0.5)
tx=CreateTexture(sz,sz,3)
SetBuffer TextureBuffer(tx)
LockBuffer
For x=0 To sz-1
For y=0 To sz-1
WritePixelFast x,y,0;+$ff000000
Next
Next
UnlockBuffer
;--------------------generate picture
For ix#=0 To strn-1 ;Step 2;5
max#=strn
kStep#=(0.0+ix)/max#
kStepi#=1-kStep#
k0#=((kStep*10) And 7)*0.11794
k#=(ix And 3)
;----select color
Clr=Rnd(10)
Select True
Case Clr<8
r=255:g=100:b=0
Case Clr>9
r=000:g=0:b=200*kStepi#
Default
r=155:g=100*kStep#:b=0
End Select
s#=0
a#=0.590+Rnd(0.08)
pos#=2
Xsm#=0
;-----loop
While pos#<strn
otklonenie#=1-((Abs(pos)/strn))
x=(ix#)*otklonenie#*otklonenie#*otklonenie#
Xsm#=Xsm#+(x-Xsm)*(0.09+(1-otklonenie#)*0.5)
;----correkt color
cr=( r*otklonenie# And $ff) Shl 16
cg=( g*otklonenie# And $ff) Shl 8
cb=( b*otklonenie# And $ff)
ca=((155*otklonenie#+100) And $ff) Shl 24
col=cr+cg+cb+ca
;----------position
Select kadr
Case 0
Px=strn+pos+Xsm#:Py=strn+pos-Xsm#
Case 1
Px=strn-pos-Xsm#:Py=strn-pos+Xsm#
Case 2
Px=strn-pos+Xsm#:Py=strn-pos-Xsm#
Case 3
Px=strn+pos-Xsm#:Py=strn+pos+Xsm#
End Select
For dpl=1 To Size*3
WritePixel Px+Rnd(-1,1),Py+Rnd(-1,1),col ;Shr 1
Next
WritePixel Px,Py,col
s#=s+a
pos#=pos#+s#
kadr=kadr+1: If kadr>3 kadr=0
Wend
Next
Return Tx
End Function
;------------------------------------------------------------------------------------------------------------
Function FireMesh(w#=1,h#=1,par)
Mes=CreateMesh(par):CrSur=CreateSurface(Mes)
AddVertex(CrSur,-w,0,0,1,0,0)
AddVertex(CrSur,0,h,0,1,1,0)
AddVertex(CrSur,w,0,0,0,1,0)
AddVertex(CrSur,0,0,w#,0,1,0)
AddVertex(CrSur,0,h,0,0,0,0)
AddVertex(CrSur,0,0,-w#,1,0,0)
AddTriangle(CrSur,0,1,2)
AddTriangle(CrSur,3,4,5)
Return mes
End Function
;------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------
Function MakeTx_001(sz=32)
tx=CreateTexture(sz,sz)
SetBuffer TextureBuffer(tx)
ClsColor 80,40,10:Cls
For i1=1 To 320
b=Rnd(-20,20):Color 80+b,40+b,10
x=Rnd(sz):y=Rnd(sz)
For i=1 To 4
Plot x+Rnd(-1,1),y+Rnd(-1,1)
Next:Next
Return tx
End Function
;------------------------------------------------------------------------------------------------------------