Извините, ничего не найдено.

Bagration · 29.11.2007, 00:39

Мда... Ворон, соблюдай форматирование нормальное - читать НЕВОЗМОЖНО.

WaReZ_MEN · 29.11.2007, 02:12

Воспользуисе тегом код а то читать не возможно...

BOPOH · 29.11.2007, 09:52

блин . . вчерась поздно было . . .дико звиняюсь . . .
тут фишка что пламя само по себе горит . . его просчитывать ненуна. . .
создал и фсё. . .(если кому интерестно стучитесь в асю)


;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 
;------------------------------------------------------------------------------------------------------------

Halk-DS · 06.01.2008, 12:37

Блин! Классный огонь то, мне он чёто варкрафт3 напоминает!

AndruXa · 21.02.2008, 00:21

А вот еще огонь, не помню где нашел...Тока его бы еще в 3д переделать, ато спрайтом не катит

Type element
 Field x#,y#,z#
End Type

Type particle
 Field x#,y#,t#,h,ang#
End Type

Const framq=32,siz=32,siz2=siz/2
Const dd#=.01,drad#=.3,dy#=.1

Graphics3D 800,600

fire=CreateTexture(siz,siz,6,framq)
For n=0 To framq-1
 firebuf=TextureBuffer(fire,n)
 LockBuffer firebuf
 t#=1.0*n/framq
 dt=Floor(1024*t#) Mod 256
 r=255
 g=255
 b=255
 If t#>=.25 Then
  b=255-dt
  If t#>=.5 Then
   b=0
   g=255-dt
   If t#>=.75 Then g=0
  End If 
 End If 
 
 Dim q#(siz,siz)
 For nn=0 To 5
  For x=0 To siz-1
   For y=0 To siz-1
    Select nn
     Case 0
      rad#=1.0-1.0*Sqr((x-siz2)*(x-siz2)+(y-siz2)*(y-siz2))/siz2
      If rad#<0 Then rad#=0
      q(x,y)=Rnd(0,1)*rad#
     Case 5
      a=Floor((255-255*n/framq)*q(x,y))
      WritePixelFast x,y,a Shl 24+r Shl 16+g Shl 8+b,firebuf:q(x,y)=0
     Default
      If x>0 And y>0 And x<siz-1 And y<siz-1 Then
       q(x,y)=.2*(q(x-1,y)+q(x+1,y)+q(x,y-1)+q(x,y+1)+q(x,y))
      End If
    End Select
   Next
  Next
 Next
 UnlockBuffer firebuf
Next

SetBuffer BackBuffer()

piv=CreatePivot()
PositionEntity CreateCamera(piv),0,10,-30
RotateEntity CreateLight(),45,0,45

SetBuffer BackBuffer()
Repeat
 For n=1 To 6
  p.particle=New particle
  p\ang=Rnd(-180,180)
  p\h=CreateSprite()
  EntityFX p\h,5+32
 Next
 n=0
 For p=Each particle

  p\x=p\x+.3*Sin(p\ang)
  p\y=p\y+.3*Cos(p\ang)
  p\t=p\t+.0003*(30+Abs(p\ang))+.0005*Abs(p\x)
  p\ang=p\ang-Sgn(p\ang)*2
  TurnEntity p\h,0,0,5
  sc#=3.5*(1.0-Abs(p\t-.45))
  n=n+1

  If p\t>=1 Then
   FreeEntity p\h
   Delete p
  Else
  PositionEntity p\h,p\x+.5*Cos(p\y*30),p\y,0
  ScaleSprite p\h,sc#,sc#
  EntityTexture p\h,fire,Floor(p\t*framq)
  End If
 Next
 
 RenderWorld
 Text 0,0,"Particle quantity:"+n
 Flip
 Delay 50
Until KeyHit(1)