Good particle system - GameCreators Forum

Author

Message

Zotoaster

19

Years of Service

User Offline

Joined: 20th Dec 2004

Location: Scotland

Posted: 12th Dec 2006 18:45 Edited at: 12th Dec 2006 19:33

Link

It works pretty well so far, all I have to do is make it texturable and make the alpha mapping better, meanwhile, here's a demo.

Move the mouse around and hit the little... thing.. lol

[edit]
Changed code a little, now it's a little neater to look at

`setup
sync on : sync rate 60
load dll "user32.dll",1
   sw=call dll(1,"GetSystemMetrics",0)
   sh=call dll(1,"GetSystemMetrics",1)
   set display mode sw,sh,32
delete dll 1
hide mouse
backdrop on : color backdrop 0

`Ball data
ox#=screen width()/2 : oy#=screen height()/2
mass#=100 : radius=10

`Create Particles
setupParticles()
prt1=addParticles(0,0,0,30,30)
setParticleSize(prt1,120,-4)
colorParticles(prt1,255,0,0)
prt2=addParticles(0,0,0,30,30)
setParticleSize(prt2,120,-4)
colorParticles(prt2,0,255,0)
prt3=addParticles(0,0,0,30,30)
setParticleSize(prt3,120,-4)
colorParticles(prt3,0,0,255)
prt4=addParticles(0,0,0,30,30)
setParticleSize(prt4,120,-4)
colorParticles(prt4,255,255,0)
prt5=addParticles(0,0,0,30,30)
setParticleSize(prt5,120,-4)

pball=addParticles(0,0,0,30,30)
setParticleSize(pball,120,-4)
colorParticles(pball,0,128,250)

createParticles()

`Mode
mode=1

`Main Loop
do

if mode=1
      pick screen mousex(),mousey(),1000
      px#=get pick vector x()+plusmin(rnd(15))
      py#=get pick vector y()+plusmin(rnd(15))
      pz#=get pick vector z()+plusmin(rnd(15))
   else
      pick screen (screen width()/2)+plusmin(rnd(screen width()/2)),screen height(),1000
      px#=get pick vector x()
      py#=get pick vector y()
      pz#=get pick vector z()
   endif

positionParticles(prt1,px#,py#,pz#)
   positionParticles(prt2,px#,py#,pz#)
   positionParticles(prt3,px#,py#,pz#)
   positionParticles(prt4,px#,py#,pz#)
   positionParticles(prt5,px#,py#,pz#)
   ang#=wrapvalue(ang#+2) : grav#=6
   for p=prt1 to prt4
      setParticleGravity(p,sin(ang#+(p*90))*grav#,(cos(ang#+(p*90))*grav#)+(grav#*(1-mode)),0)
      setParticleAlpha(p,sin(ang#)*100)
   next p
   setParticleGravity(prt5,0,(grav#*(1-mode)),0)

dist#=sqrt((mousex()-ox#)^2+(mousey()-oy#)^2)
   omang#=atanfull(mousex()-ox#,mousey()-oy#)
   frc#=-((mass#*radius)/dist#)*2
   frcx#=sin(omang#)*frc#
   frcy#=cos(omang#)*frc#
   accx#=frcx#/mass#
   accy#=frcy#/mass#
   spdx#=spdx#+accx#
   spdy#=spdy#+accy#
   ox#=ox#+spdx#
   oy#=oy#+spdy#
   spdx#=spdx#*0.98
   spdy#=spdy#*0.98
   if ox#<=0 then spdx#=0-spdx#
   if oy#<=0 then spdy#=0-spdy#
   if ox#>=screen width() then spdx#=0-spdx#
   if oy#>=screen height() then spdy#=0-spdy#

pick screen ox#,oy#,1000
   bx#=get pick vector x()
   by#=get pick vector y()
   bz#=get pick vector z()
   positionParticles(pball,bx#,by#,bz#)

controlParticles()

sync
loop

function plusmin(num#)
   rand=rnd(10)
   if rand>5 then ret#=num#*-1 else ret#=num#
endfunction ret#

function setupParticles()
   dim prtsys(0) as tprtsys
endfunction
function createParticles()
   count=array count(prtsys())
   cmax=0
   for c=1 to count
      if prtsys(c).count>cmax then cmax=prtsys(c).count
   next c
   dim prtdat(array count(prtsys()),cmax) as tprtdat
   for c=1 to array count(prtsys())
      for o=1 to prtsys(c).count
         prtdat(c,o).obj=val(getToken(prtsys(c).objc,",",o))
      next o
   next c
endfunction count

function addParticles(x#,y#,z#,life,count)
   array insert at bottom prtsys()
   num=array count(prtsys())
   prtsys(num).pos.x=x#+plusmin(rnd(0.2))
   prtsys(num).pos.y=y#+plusmin(rnd(0.2))
   prtsys(num).pos.z=z#+plusmin(rnd(0.2))
   prtsys(num).life=life
   prtsys(num).count=count
   prtsys(num).alpha=100
   for c=1 to prtsys().count
      obj=zp_freeobject() : make object plain obj,20,20
      set object transparency obj,3
      disable object zwrite obj
      ghost object on obj
      position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      obj$=obj$+str$(obj)+","
      lifep=rnd(life)
      life$=life$+str$(lifep)+","
   next c
   prtsys(num).objc=obj$
   prtsys(num).lifep=life$
endfunction num
function setParticleSpeed(num,speed#)
   prtsys(num).speed=speed#
endfunction
function setParticleSize(num,size#,sizep#)
   prtsys(num).sizei=size#
   prtsys(num).sizep=sizep#
   for c=1 to prtsys(num).count
      obj=val(getToken(prtsys(num).objc,",",c))
      scale object obj,size#,size#,1
   next c
endfunction
function setParticleAlpha(num,alpha)
   prtsys(num).alpha=alpha
endfunction
function positionParticles(num,x#,y#,z#)
   prtsys(num).pos.x=x#
   prtsys(num).pos.y=y#
   prtsys(num).pos.z=z#
endfunction
function setParticleGravity(num,x#,y#,z#)
   prtsys(num).grav.x=x#
   prtsys(num).grav.y=y#
   prtsys(num).grav.z=z#
endfunction
function colorParticles(num,r,g,b)
col=rgb(r,g,b)
   for c=1 to prtsys(num).count
      obj=val(getToken(prtsys(num).objc,",",c))
      color object obj,col
   next c
endfunction

function controlParticles()
for num=1 to array count(prtsys())
   for c=1 to prtsys(num).count
      prtsys(num).lifec=prtsys(num).lifec+1
      prtsys(num).lifecount=prtsys(num).life-prtsys(num).lifec
      obj=prtdat(num,c).obj
      angx#=angx#+((360/prtsys(num).count)*c)
      angy#=angy#+((360/prtsys(num).count)*c)
      sx#=object position x(obj)+(sin(angy#)*cos(angx#)*prtsys(num).speed)
      sy#=object position y(obj)-(sin(angx#)*prtsys(num).speed)
      sz#=object position z(obj)+(cos(angy#)*cos(angx#)*prtsys(num).speed)
      sx#=sx#+prtsys(num).grav.x
      sy#=sy#+prtsys(num).grav.y
      sz#=sz#+prtsys(num).grav.z
      size#=prtsys(num).sizei+(prtsys(num).sizep*prtsys(num).lifecount)
      position object obj,sx#,sy#,sz#
      scale object obj,size#,size#,1
      set alpha mapping on obj,prtsys(num).alpha
      if prtsys(num).lifec>prtsys(num).life
         prtsys(num).lifec=prtsys(num).lifec*0
         size#=prtsys(num).sizei
         position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      endif
   next c
next num
endfunction

`Functions
function zp_freeobject()
   repeat
      inc i
   until object exist(i)=0
endfunction i

function getTokens(st$,sp$)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
repeat
   inc counter
   cur$=mid$(nst$,counter)
   if cur$=sp$ then inc splits
until counter>len(nst$)
tokens=splits-1
endfunction tokens
function getToken(st$,sp$,num)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$=sp$ then inc splits
   until splits=num or counter>len(st$)
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$<>sp$ then token$=token$+cur$
   until cur$=sp$ or counter>len(st$)
endfunction token$

`UDTs
type vec3
   x as float
   y as float
   z as float
endtype
type tprtsys
   objc as string
   pos as vec3
   life as integer
   lifec as integer
   lifecount as integer
   lifep as string
   count as integer
   speed as float
   sizei as float
   sizep as float
   alpha as integer
   grav as vec3
endtype
type tprtdat
   obj as integer
endtype

+ Code Snippet

`setup
sync on : sync rate 60
load dll "user32.dll",1
   sw=call dll(1,"GetSystemMetrics",0)
   sh=call dll(1,"GetSystemMetrics",1)
   set display mode sw,sh,32
delete dll 1
hide mouse
backdrop on : color backdrop 0

`Ball data
ox#=screen width()/2 : oy#=screen height()/2
mass#=100 : radius=10

`Create Particles
setupParticles()
prt1=addParticles(0,0,0,30,30)
setParticleSize(prt1,120,-4)
colorParticles(prt1,255,0,0)
prt2=addParticles(0,0,0,30,30)
setParticleSize(prt2,120,-4)
colorParticles(prt2,0,255,0)
prt3=addParticles(0,0,0,30,30)
setParticleSize(prt3,120,-4)
colorParticles(prt3,0,0,255)
prt4=addParticles(0,0,0,30,30)
setParticleSize(prt4,120,-4)
colorParticles(prt4,255,255,0)
prt5=addParticles(0,0,0,30,30)
setParticleSize(prt5,120,-4)

pball=addParticles(0,0,0,30,30)
setParticleSize(pball,120,-4)
colorParticles(pball,0,128,250)



createParticles()

`Mode
mode=1

`Main Loop
do


   if mode=1
      pick screen mousex(),mousey(),1000
      px#=get pick vector x()+plusmin(rnd(15))
      py#=get pick vector y()+plusmin(rnd(15))
      pz#=get pick vector z()+plusmin(rnd(15))
   else
      pick screen (screen width()/2)+plusmin(rnd(screen width()/2)),screen height(),1000
      px#=get pick vector x()
      py#=get pick vector y()
      pz#=get pick vector z()
   endif

   positionParticles(prt1,px#,py#,pz#)
   positionParticles(prt2,px#,py#,pz#)
   positionParticles(prt3,px#,py#,pz#)
   positionParticles(prt4,px#,py#,pz#)
   positionParticles(prt5,px#,py#,pz#)
   ang#=wrapvalue(ang#+2) : grav#=6
   for p=prt1 to prt4
      setParticleGravity(p,sin(ang#+(p*90))*grav#,(cos(ang#+(p*90))*grav#)+(grav#*(1-mode)),0)
      setParticleAlpha(p,sin(ang#)*100)
   next p
   setParticleGravity(prt5,0,(grav#*(1-mode)),0)

   dist#=sqrt((mousex()-ox#)^2+(mousey()-oy#)^2)
   omang#=atanfull(mousex()-ox#,mousey()-oy#)
   frc#=-((mass#*radius)/dist#)*2
   frcx#=sin(omang#)*frc#
   frcy#=cos(omang#)*frc#
   accx#=frcx#/mass#
   accy#=frcy#/mass#
   spdx#=spdx#+accx#
   spdy#=spdy#+accy#
   ox#=ox#+spdx#
   oy#=oy#+spdy#
   spdx#=spdx#*0.98
   spdy#=spdy#*0.98
   if ox#<=0 then spdx#=0-spdx#
   if oy#<=0 then spdy#=0-spdy#
   if ox#>=screen width() then spdx#=0-spdx#
   if oy#>=screen height() then spdy#=0-spdy#

   pick screen ox#,oy#,1000
   bx#=get pick vector x()
   by#=get pick vector y()
   bz#=get pick vector z()
   positionParticles(pball,bx#,by#,bz#)

   controlParticles()

sync
loop


function plusmin(num#)
   rand=rnd(10)
   if rand>5 then ret#=num#*-1 else ret#=num#
endfunction ret#

function setupParticles()
   dim prtsys(0) as tprtsys
endfunction
function createParticles()
   count=array count(prtsys())
   cmax=0
   for c=1 to count
      if prtsys(c).count>cmax then cmax=prtsys(c).count
   next c
   dim prtdat(array count(prtsys()),cmax) as tprtdat
   for c=1 to array count(prtsys())
      for o=1 to prtsys(c).count
         prtdat(c,o).obj=val(getToken(prtsys(c).objc,",",o))
      next o
   next c
endfunction count

function addParticles(x#,y#,z#,life,count)
   array insert at bottom prtsys()
   num=array count(prtsys())
   prtsys(num).pos.x=x#+plusmin(rnd(0.2))
   prtsys(num).pos.y=y#+plusmin(rnd(0.2))
   prtsys(num).pos.z=z#+plusmin(rnd(0.2))
   prtsys(num).life=life
   prtsys(num).count=count
   prtsys(num).alpha=100
   for c=1 to prtsys().count
      obj=zp_freeobject() : make object plain obj,20,20
      set object transparency obj,3
      disable object zwrite obj
      ghost object on obj
      position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      obj$=obj$+str$(obj)+","
      lifep=rnd(life)
      life$=life$+str$(lifep)+","
   next c
   prtsys(num).objc=obj$
   prtsys(num).lifep=life$
endfunction num
function setParticleSpeed(num,speed#)
   prtsys(num).speed=speed#
endfunction
function setParticleSize(num,size#,sizep#)
   prtsys(num).sizei=size#
   prtsys(num).sizep=sizep#
   for c=1 to prtsys(num).count
      obj=val(getToken(prtsys(num).objc,",",c))
      scale object obj,size#,size#,1
   next c
endfunction
function setParticleAlpha(num,alpha)
   prtsys(num).alpha=alpha
endfunction
function positionParticles(num,x#,y#,z#)
   prtsys(num).pos.x=x#
   prtsys(num).pos.y=y#
   prtsys(num).pos.z=z#
endfunction
function setParticleGravity(num,x#,y#,z#)
   prtsys(num).grav.x=x#
   prtsys(num).grav.y=y#
   prtsys(num).grav.z=z#
endfunction
function colorParticles(num,r,g,b)
col=rgb(r,g,b)
   for c=1 to prtsys(num).count
      obj=val(getToken(prtsys(num).objc,",",c))
      color object obj,col
   next c
endfunction

function controlParticles()
for num=1 to array count(prtsys())
   for c=1 to prtsys(num).count
      prtsys(num).lifec=prtsys(num).lifec+1
      prtsys(num).lifecount=prtsys(num).life-prtsys(num).lifec
      obj=prtdat(num,c).obj
      angx#=angx#+((360/prtsys(num).count)*c)
      angy#=angy#+((360/prtsys(num).count)*c)
      sx#=object position x(obj)+(sin(angy#)*cos(angx#)*prtsys(num).speed)
      sy#=object position y(obj)-(sin(angx#)*prtsys(num).speed)
      sz#=object position z(obj)+(cos(angy#)*cos(angx#)*prtsys(num).speed)
      sx#=sx#+prtsys(num).grav.x
      sy#=sy#+prtsys(num).grav.y
      sz#=sz#+prtsys(num).grav.z
      size#=prtsys(num).sizei+(prtsys(num).sizep*prtsys(num).lifecount)
      position object obj,sx#,sy#,sz#
      scale object obj,size#,size#,1
      set alpha mapping on obj,prtsys(num).alpha
      if prtsys(num).lifec>prtsys(num).life
         prtsys(num).lifec=prtsys(num).lifec*0
         size#=prtsys(num).sizei
         position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      endif
   next c
next num
endfunction


`Functions
function zp_freeobject()
   repeat
      inc i
   until object exist(i)=0
endfunction i


function getTokens(st$,sp$)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
repeat
   inc counter
   cur$=mid$(nst$,counter)
   if cur$=sp$ then inc splits
until counter>len(nst$)
tokens=splits-1
endfunction tokens
function getToken(st$,sp$,num)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$=sp$ then inc splits
   until splits=num or counter>len(st$)
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$<>sp$ then token$=token$+cur$
   until cur$=sp$ or counter>len(st$)
endfunction token$


`UDTs
type vec3
   x as float
   y as float
   z as float
endtype
type tprtsys
   objc as string
   pos as vec3
   life as integer
   lifec as integer
   lifecount as integer
   lifep as string
   count as integer
   speed as float
   sizei as float
   sizep as float
   alpha as integer
   grav as vec3
endtype
type tprtdat
   obj as integer
endtype

Back to top

Profile PM Email

El Goorf

18

Years of Service

User Offline

Joined: 17th Sep 2006

Location: Uni: Manchester, Home: Dunstable

Posted: 12th Dec 2006 18:55

Link

wow, that looks like my field effect

Back to top

Profile PM Website

Zotoaster

19

Years of Service

User Offline

Joined: 20th Dec 2004

Location: Scotland

Posted: 12th Dec 2006 19:27

Link

Try changing the mode variable to 0.

Back to top

Profile PM Email

Zotoaster

19

Years of Service

User Offline

Joined: 20th Dec 2004

Location: Scotland

Posted: 12th Dec 2006 20:01 Edited at: 12th Dec 2006 21:16

Link

Here's another good one.

`setup
sync on : sync rate 60
load dll "user32.dll",1
   sw=call dll(1,"GetSystemMetrics",0)
   sh=call dll(1,"GetSystemMetrics",1)
   set display mode sw,sh,32
delete dll 1
hide mouse
backdrop on : color backdrop 0

`Ball data
ox#=screen width()/2 : oy#=screen height()/2
mass#=100 : radius=10

`Create Particles
setupParticles()
prt1=addParticles(0,0,0,30,30)
setParticleSize(prt1,120,-4)
colorParticles(prt1,255,0,0)
prt2=addParticles(0,0,0,30,30)
setParticleSize(prt2,120,-4)
colorParticles(prt2,0,255,0)
prt3=addParticles(0,0,0,30,30)
setParticleSize(prt3,120,-4)
colorParticles(prt3,0,0,255)
prt4=addParticles(0,0,0,30,30)
setParticleSize(prt4,120,-4)
colorParticles(prt4,255,255,0)
prt5=addParticles(0,0,0,30,30)
setParticleSize(prt5,120,-4)

pball=addParticles(0,0,0,30,30)
setParticleSize(pball,120,-4)
colorParticles(pball,0,128,250)

pfire2=addParticles(0,0,0,60,60)
setParticleSize(pfire2,240,-4)
colorParticles(pfire2,0,0,128)

pfire=addParticles(0,0,0,60,60)
setParticleSize(pfire,240,-4)
colorParticles(pfire,255,128,0)

createParticles()

`Mode
mode=1

`Main Loop
do

if mode=1
      pick screen mousex(),mousey(),1000
      px#=get pick vector x()+plusmin(rnd(15))
      py#=get pick vector y()+plusmin(rnd(15))
      pz#=get pick vector z()+plusmin(rnd(15))
   else
      pick screen (screen width()/2)+plusmin(rnd(screen width()/2)),screen height(),1000
      px#=get pick vector x()
      py#=get pick vector y()
      pz#=get pick vector z()
   endif

pick screen (screen width()/2)+plusmin(rnd(screen width()/2)),screen height(),1000
      fx#=get pick vector x()
      fy#=get pick vector y()
      fz#=get pick vector z()

pick screen (screen width()/2)+plusmin(rnd(screen width()/2)),screen height(),1000
      f2x#=get pick vector x()
      f2y#=get pick vector y()
      f2z#=get pick vector z()

positionParticles(prt1,px#,py#,pz#)
   positionParticles(prt2,px#,py#,pz#)
   positionParticles(prt3,px#,py#,pz#)
   positionParticles(prt4,px#,py#,pz#)
   positionParticles(prt5,px#,py#,pz#)
   positionParticles(pfire,fx#,fy#,fz#)
   positionParticles(pfire2,f2x#,f2y#,f2z#)
   ang#=wrapvalue(ang#+2) : grav#=6
   for p=prt1 to prt4
      setParticleGravity(p,sin(ang#+(p*90))*grav#,(cos(ang#+(p*90))*grav#)+(grav#*(1-mode)),0)
      setParticleAlpha(p,sin(ang#)*100)
   next p
   setParticleGravity(prt5,0,(grav#*(1-mode)),0)
   setParticleGravity(pfire,0,grav#,0)
   setParticleGravity(pfire2,0,grav#,0)

dist#=sqrt((mousex()-ox#)^2+(mousey()-oy#)^2)
   omang#=atanfull(mousex()-ox#,mousey()-oy#)
   frc#=-((mass#*radius)/dist#)*2
   frcx#=sin(omang#)*frc#
   frcy#=(cos(omang#)*frc#)
   accx#=frcx#/mass#
   accy#=frcy#/mass#
   spdx#=spdx#+accx#
   spdy#=spdy#+accy#
   ox#=ox#+spdx#
   oy#=oy#+spdy#
   spdx#=spdx#*0.98
   spdy#=spdy#*0.98
   if ox#<=0 then spdx#=0-spdx#
   if oy#<=0 then spdy#=0-spdy#
   if ox#>=screen width() then spdx#=0-spdx#
   if oy#>=screen height() then spdy#=0-spdy#

pick screen ox#,oy#,1000
   bx#=get pick vector x()
   by#=get pick vector y()
   bz#=get pick vector z()
   positionParticles(pball,bx#,by#,bz#)

controlParticles()

sync
loop

function plusmin(num#)
   rand=rnd(10)
   if rand>5 then ret#=num#*-1 else ret#=num#
endfunction ret#

function setupParticles()
   dim prtsys(0) as tprtsys
endfunction
function createParticles()
   count=array count(prtsys())
   cmax=0
   for c=1 to count
      if prtsys(c).count>cmax then cmax=prtsys(c).count
   next c
   dim prtdat(array count(prtsys()),cmax) as tprtdat
   for c=1 to array count(prtsys())
      for o=1 to prtsys(c).count
         prtdat(c,o).obj=val(getToken(prtsys(c).objc,",",o))
      next o
   next c
endfunction count

function addParticles(x#,y#,z#,life,count)
   array insert at bottom prtsys()
   num=array count(prtsys())
   prtsys(num).pos.x=x#+plusmin(rnd(0.2))
   prtsys(num).pos.y=y#+plusmin(rnd(0.2))
   prtsys(num).pos.z=z#+plusmin(rnd(0.2))
   prtsys(num).life=life
   prtsys(num).count=count
   prtsys(num).alpha=100
   for c=1 to prtsys().count
      obj=zp_freeobject() : make object plain obj,20,20
      set object transparency obj,3
      disable object zwrite obj
      ghost object on obj
      position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      obj$=obj$+str$(obj)+","
      lifep=rnd(life)
      life$=life$+str$(lifep)+","
   next c
   prtsys(num).objc=obj$
   prtsys(num).lifep=life$
endfunction num
function setParticleSpeed(num,speed#)
   prtsys(num).speed=speed#
endfunction
function setParticleSize(num,size#,sizep#)
   prtsys(num).sizei=size#
   prtsys(num).sizep=sizep#
   for c=1 to prtsys(num).count
      obj=val(getToken(prtsys(num).objc,",",c))
      scale object obj,size#,size#,1
   next c
endfunction
function setParticleAlpha(num,alpha)
   prtsys(num).alpha=alpha
endfunction
function positionParticles(num,x#,y#,z#)
   prtsys(num).pos.x=x#
   prtsys(num).pos.y=y#
   prtsys(num).pos.z=z#
endfunction
function setParticleGravity(num,x#,y#,z#)
   prtsys(num).grav.x=x#
   prtsys(num).grav.y=y#
   prtsys(num).grav.z=z#
endfunction
function colorParticles(num,r,g,b)
col=rgb(r,g,b)
   for c=1 to prtsys(num).count
      obj=val(getToken(prtsys(num).objc,",",c))
      color object obj,col
   next c
endfunction

function controlParticles()
for num=1 to array count(prtsys())
   for c=1 to prtsys(num).count
      prtsys(num).lifec=prtsys(num).lifec+1
      prtsys(num).lifecount=prtsys(num).life-prtsys(num).lifec
      obj=prtdat(num,c).obj
      angx#=angx#+((360/prtsys(num).count)*c)
      angy#=angy#+((360/prtsys(num).count)*c)
      sx#=object position x(obj)+(sin(angy#)*cos(angx#)*prtsys(num).speed)
      sy#=object position y(obj)-(sin(angx#)*prtsys(num).speed)
      sz#=object position z(obj)+(cos(angy#)*cos(angx#)*prtsys(num).speed)
      sx#=sx#+prtsys(num).grav.x
      sy#=sy#+prtsys(num).grav.y
      sz#=sz#+prtsys(num).grav.z
      size#=prtsys(num).sizei+(prtsys(num).sizep*prtsys(num).lifecount)
      position object obj,sx#,sy#,sz#
      scale object obj,size#,size#,1
      set alpha mapping on obj,prtsys(num).alpha
      if prtsys(num).lifec>prtsys(num).life
         prtsys(num).lifec=prtsys(num).lifec*0
         size#=prtsys(num).sizei
         position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      endif
   next c
next num
endfunction

`Functions
function zp_freeobject()
   repeat
      inc i
   until object exist(i)=0
endfunction i

function getTokens(st$,sp$)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
repeat
   inc counter
   cur$=mid$(nst$,counter)
   if cur$=sp$ then inc splits
until counter>len(nst$)
tokens=splits-1
endfunction tokens
function getToken(st$,sp$,num)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$=sp$ then inc splits
   until splits=num or counter>len(st$)
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$<>sp$ then token$=token$+cur$
   until cur$=sp$ or counter>len(st$)
endfunction token$

`UDTs
type vec3
   x as float
   y as float
   z as float
endtype
type tprtsys
   objc as string
   pos as vec3
   life as integer
   lifec as integer
   lifecount as integer
   lifep as string
   count as integer
   speed as float
   sizei as float
   sizep as float
   alpha as integer
   grav as vec3
endtype
type tprtdat
   obj as integer
endtype

+ Code Snippet

`setup
sync on : sync rate 60
load dll "user32.dll",1
   sw=call dll(1,"GetSystemMetrics",0)
   sh=call dll(1,"GetSystemMetrics",1)
   set display mode sw,sh,32
delete dll 1
hide mouse
backdrop on : color backdrop 0

`Ball data
ox#=screen width()/2 : oy#=screen height()/2
mass#=100 : radius=10

`Create Particles
setupParticles()
prt1=addParticles(0,0,0,30,30)
setParticleSize(prt1,120,-4)
colorParticles(prt1,255,0,0)
prt2=addParticles(0,0,0,30,30)
setParticleSize(prt2,120,-4)
colorParticles(prt2,0,255,0)
prt3=addParticles(0,0,0,30,30)
setParticleSize(prt3,120,-4)
colorParticles(prt3,0,0,255)
prt4=addParticles(0,0,0,30,30)
setParticleSize(prt4,120,-4)
colorParticles(prt4,255,255,0)
prt5=addParticles(0,0,0,30,30)
setParticleSize(prt5,120,-4)

pball=addParticles(0,0,0,30,30)
setParticleSize(pball,120,-4)
colorParticles(pball,0,128,250)

pfire2=addParticles(0,0,0,60,60)
setParticleSize(pfire2,240,-4)
colorParticles(pfire2,0,0,128)

pfire=addParticles(0,0,0,60,60)
setParticleSize(pfire,240,-4)
colorParticles(pfire,255,128,0)


createParticles()

`Mode
mode=1

`Main Loop
do


   if mode=1
      pick screen mousex(),mousey(),1000
      px#=get pick vector x()+plusmin(rnd(15))
      py#=get pick vector y()+plusmin(rnd(15))
      pz#=get pick vector z()+plusmin(rnd(15))
   else
      pick screen (screen width()/2)+plusmin(rnd(screen width()/2)),screen height(),1000
      px#=get pick vector x()
      py#=get pick vector y()
      pz#=get pick vector z()
   endif

   pick screen (screen width()/2)+plusmin(rnd(screen width()/2)),screen height(),1000
      fx#=get pick vector x()
      fy#=get pick vector y()
      fz#=get pick vector z()

   pick screen (screen width()/2)+plusmin(rnd(screen width()/2)),screen height(),1000
      f2x#=get pick vector x()
      f2y#=get pick vector y()
      f2z#=get pick vector z()

   positionParticles(prt1,px#,py#,pz#)
   positionParticles(prt2,px#,py#,pz#)
   positionParticles(prt3,px#,py#,pz#)
   positionParticles(prt4,px#,py#,pz#)
   positionParticles(prt5,px#,py#,pz#)
   positionParticles(pfire,fx#,fy#,fz#)
   positionParticles(pfire2,f2x#,f2y#,f2z#)
   ang#=wrapvalue(ang#+2) : grav#=6
   for p=prt1 to prt4
      setParticleGravity(p,sin(ang#+(p*90))*grav#,(cos(ang#+(p*90))*grav#)+(grav#*(1-mode)),0)
      setParticleAlpha(p,sin(ang#)*100)
   next p
   setParticleGravity(prt5,0,(grav#*(1-mode)),0)
   setParticleGravity(pfire,0,grav#,0)
   setParticleGravity(pfire2,0,grav#,0)

   dist#=sqrt((mousex()-ox#)^2+(mousey()-oy#)^2)
   omang#=atanfull(mousex()-ox#,mousey()-oy#)
   frc#=-((mass#*radius)/dist#)*2
   frcx#=sin(omang#)*frc#
   frcy#=(cos(omang#)*frc#)
   accx#=frcx#/mass#
   accy#=frcy#/mass#
   spdx#=spdx#+accx#
   spdy#=spdy#+accy#
   ox#=ox#+spdx#
   oy#=oy#+spdy#
   spdx#=spdx#*0.98
   spdy#=spdy#*0.98
   if ox#<=0 then spdx#=0-spdx#
   if oy#<=0 then spdy#=0-spdy#
   if ox#>=screen width() then spdx#=0-spdx#
   if oy#>=screen height() then spdy#=0-spdy#

   pick screen ox#,oy#,1000
   bx#=get pick vector x()
   by#=get pick vector y()
   bz#=get pick vector z()
   positionParticles(pball,bx#,by#,bz#)

   controlParticles()

sync
loop


function plusmin(num#)
   rand=rnd(10)
   if rand>5 then ret#=num#*-1 else ret#=num#
endfunction ret#

function setupParticles()
   dim prtsys(0) as tprtsys
endfunction
function createParticles()
   count=array count(prtsys())
   cmax=0
   for c=1 to count
      if prtsys(c).count>cmax then cmax=prtsys(c).count
   next c
   dim prtdat(array count(prtsys()),cmax) as tprtdat
   for c=1 to array count(prtsys())
      for o=1 to prtsys(c).count
         prtdat(c,o).obj=val(getToken(prtsys(c).objc,",",o))
      next o
   next c
endfunction count

function addParticles(x#,y#,z#,life,count)
   array insert at bottom prtsys()
   num=array count(prtsys())
   prtsys(num).pos.x=x#+plusmin(rnd(0.2))
   prtsys(num).pos.y=y#+plusmin(rnd(0.2))
   prtsys(num).pos.z=z#+plusmin(rnd(0.2))
   prtsys(num).life=life
   prtsys(num).count=count
   prtsys(num).alpha=100
   for c=1 to prtsys().count
      obj=zp_freeobject() : make object plain obj,20,20
      set object transparency obj,3
      disable object zwrite obj
      ghost object on obj
      position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      obj$=obj$+str$(obj)+","
      lifep=rnd(life)
      life$=life$+str$(lifep)+","
   next c
   prtsys(num).objc=obj$
   prtsys(num).lifep=life$
endfunction num
function setParticleSpeed(num,speed#)
   prtsys(num).speed=speed#
endfunction
function setParticleSize(num,size#,sizep#)
   prtsys(num).sizei=size#
   prtsys(num).sizep=sizep#
   for c=1 to prtsys(num).count
      obj=val(getToken(prtsys(num).objc,",",c))
      scale object obj,size#,size#,1
   next c
endfunction
function setParticleAlpha(num,alpha)
   prtsys(num).alpha=alpha
endfunction
function positionParticles(num,x#,y#,z#)
   prtsys(num).pos.x=x#
   prtsys(num).pos.y=y#
   prtsys(num).pos.z=z#
endfunction
function setParticleGravity(num,x#,y#,z#)
   prtsys(num).grav.x=x#
   prtsys(num).grav.y=y#
   prtsys(num).grav.z=z#
endfunction
function colorParticles(num,r,g,b)
col=rgb(r,g,b)
   for c=1 to prtsys(num).count
      obj=val(getToken(prtsys(num).objc,",",c))
      color object obj,col
   next c
endfunction

function controlParticles()
for num=1 to array count(prtsys())
   for c=1 to prtsys(num).count
      prtsys(num).lifec=prtsys(num).lifec+1
      prtsys(num).lifecount=prtsys(num).life-prtsys(num).lifec
      obj=prtdat(num,c).obj
      angx#=angx#+((360/prtsys(num).count)*c)
      angy#=angy#+((360/prtsys(num).count)*c)
      sx#=object position x(obj)+(sin(angy#)*cos(angx#)*prtsys(num).speed)
      sy#=object position y(obj)-(sin(angx#)*prtsys(num).speed)
      sz#=object position z(obj)+(cos(angy#)*cos(angx#)*prtsys(num).speed)
      sx#=sx#+prtsys(num).grav.x
      sy#=sy#+prtsys(num).grav.y
      sz#=sz#+prtsys(num).grav.z
      size#=prtsys(num).sizei+(prtsys(num).sizep*prtsys(num).lifecount)
      position object obj,sx#,sy#,sz#
      scale object obj,size#,size#,1
      set alpha mapping on obj,prtsys(num).alpha
      if prtsys(num).lifec>prtsys(num).life
         prtsys(num).lifec=prtsys(num).lifec*0
         size#=prtsys(num).sizei
         position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      endif
   next c
next num
endfunction


`Functions
function zp_freeobject()
   repeat
      inc i
   until object exist(i)=0
endfunction i


function getTokens(st$,sp$)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
repeat
   inc counter
   cur$=mid$(nst$,counter)
   if cur$=sp$ then inc splits
until counter>len(nst$)
tokens=splits-1
endfunction tokens
function getToken(st$,sp$,num)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$=sp$ then inc splits
   until splits=num or counter>len(st$)
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$<>sp$ then token$=token$+cur$
   until cur$=sp$ or counter>len(st$)
endfunction token$


`UDTs
type vec3
   x as float
   y as float
   z as float
endtype
type tprtsys
   objc as string
   pos as vec3
   life as integer
   lifec as integer
   lifecount as integer
   lifep as string
   count as integer
   speed as float
   sizei as float
   sizep as float
   alpha as integer
   grav as vec3
endtype
type tprtdat
   obj as integer
endtype

[edit]
Another. Slightly less colourfull, but shows it's true purpose.

`setup
sync on : sync rate 60
load dll "user32.dll",1
   sw=call dll(1,"GetSystemMetrics",0)
   sh=call dll(1,"GetSystemMetrics",1)
   set display mode sw,sh,32
delete dll 1
hide mouse
backdrop on : color backdrop 0
set camera range 1,0x7fffffff
setupParticles()

`Make a simple boat
make object box 1,50,20,100
make object box 2,10,100,10 : make mesh from object 1,2 : delete object 2
add limb 1,1,1 : offset limb 1,1,0,45,30
delete mesh 1
make mesh from object 1,1
delete object 1
make object 1,1,0
delete mesh 1
color object 1,rgb(128,64,0)

`make sea
make matrix 1,10000,10000,50,50

`Smoke particles
psmoke=addParticles(0,0,0,30,30)
setParticleSize(psmoke,20,20)
colorParticles(psmoke,230,200,200)
setParticleGravity(psmoke,0,5,0)
setParticleAlpha(psmoke,50)

createParticles()

`Main Loop
do

`control object
   if leftkey() then yrotate object 1,wrapvalue(object angle y(1)-3)
   if rightkey() then yrotate object 1,wrapvalue(object angle y(1)+3)
   a#=object angle y(1)
   if upkey() then move object 1,10
   if downkey() then move object 1,-10
   x#=object position x(1)
   y#=object position y(1)
   z#=object position z(1)

`camera
   ca#=curveangle(a#,ca#,20.0)
   cx#=x#-(sin(ca#)*600)
   cy#=y#+300
   cz#=z#-(cos(ca#)*600)
   position camera cx#,cy#,cz# : point camera x#,y#,z#

`Particle data
   prtx#=x#+(sin(a#)*30)+plusmin(rnd(10))
   prty#=95
   prtz#=z#+(cos(a#)*30)+plusmin(rnd(10))
   positionParticles(psmoke,prtx#,prty#,prtz#)

controlParticles()

sync
loop

function plusmin(num#)
   rand=rnd(10)
   if rand>5 then ret#=num#*-1 else ret#=num#
endfunction ret#

function setupParticles()
   dim prtsys(0) as tprtsys
endfunction
function createParticles()
   count=array count(prtsys())
   cmax=0
   for c=1 to count
      if prtsys(c).count>cmax then cmax=prtsys(c).count
   next c
   dim prtdat(array count(prtsys()),cmax) as tprtdat
   for c=1 to array count(prtsys())
      for o=1 to prtsys(c).count
         prtdat(c,o).obj=val(getToken(prtsys(c).objc,",",o))
      next o
   next c
endfunction count

function addParticles(x#,y#,z#,life,count)
   array insert at bottom prtsys()
   num=array count(prtsys())
   prtsys(num).pos.x=x#+plusmin(rnd(0.2))
   prtsys(num).pos.y=y#+plusmin(rnd(0.2))
   prtsys(num).pos.z=z#+plusmin(rnd(0.2))
   prtsys(num).life=life
   prtsys(num).count=count
   prtsys(num).alpha=100
   for c=1 to prtsys().count
      obj=zp_freeobject() : make object plain obj,20,20
      set object transparency obj,3
      disable object zwrite obj
      position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      obj$=obj$+str$(obj)+","
      lifep=rnd(life)
      life$=life$+str$(lifep)+","
   next c
   prtsys(num).objc=obj$
   prtsys(num).lifep=life$
endfunction num
function setParticleSpeed(num,speed#)
   prtsys(num).speed=speed#
endfunction
function setParticleSize(num,size#,sizep#)
   prtsys(num).sizei=size#
   prtsys(num).sizep=sizep#
   for c=1 to prtsys(num).count
      obj=val(getToken(prtsys(num).objc,",",c))
      scale object obj,size#,size#,1
   next c
endfunction
function setParticleAlpha(num,alpha)
   prtsys(num).alpha=alpha
endfunction
function positionParticles(num,x#,y#,z#)
   prtsys(num).pos.x=x#
   prtsys(num).pos.y=y#
   prtsys(num).pos.z=z#
endfunction
function setParticleGravity(num,x#,y#,z#)
   prtsys(num).grav.x=x#
   prtsys(num).grav.y=y#
   prtsys(num).grav.z=z#
endfunction
function colorParticles(num,r,g,b)
col=rgb(r,g,b)
   for c=1 to prtsys(num).count
      obj=val(getToken(prtsys(num).objc,",",c))
      color object obj,col
   next c
endfunction

function controlParticles()
for num=1 to array count(prtsys())
   for c=1 to prtsys(num).count
      prtsys(num).lifec=prtsys(num).lifec+1
      prtsys(num).lifecount=prtsys(num).life-prtsys(num).lifec
      obj=prtdat(num,c).obj
      angx#=angx#+((360/prtsys(num).count)*c)
      angy#=angy#+((360/prtsys(num).count)*c)
      sx#=object position x(obj)+(sin(angy#)*cos(angx#)*prtsys(num).speed)
      sy#=object position y(obj)-(sin(angx#)*prtsys(num).speed)
      sz#=object position z(obj)+(cos(angy#)*cos(angx#)*prtsys(num).speed)
      sx#=sx#+prtsys(num).grav.x
      sy#=sy#+prtsys(num).grav.y
      sz#=sz#+prtsys(num).grav.z
      size#=prtsys(num).sizei+(prtsys(num).sizep*prtsys(num).lifecount)
      position object obj,sx#,sy#,sz#
      scale object obj,size#,size#,1
      set alpha mapping on obj,prtsys(num).alpha
      if prtsys(num).lifec>prtsys(num).life
         prtsys(num).lifec=prtsys(num).lifec*0
         size#=prtsys(num).sizei
         position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      endif
      set object to camera orientation obj
   next c
next num
endfunction

`Functions
function zp_freeobject()
   repeat
      inc i
   until object exist(i)=0
endfunction i

function getTokens(st$,sp$)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
repeat
   inc counter
   cur$=mid$(nst$,counter)
   if cur$=sp$ then inc splits
until counter>len(nst$)
tokens=splits-1
endfunction tokens
function getToken(st$,sp$,num)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$=sp$ then inc splits
   until splits=num or counter>len(st$)
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$<>sp$ then token$=token$+cur$
   until cur$=sp$ or counter>len(st$)
endfunction token$

`UDTs
type vec3
   x as float
   y as float
   z as float
endtype
type tprtsys
   objc as string
   pos as vec3
   life as integer
   lifec as integer
   lifecount as integer
   lifep as string
   count as integer
   speed as float
   sizei as float
   sizep as float
   alpha as integer
   grav as vec3
endtype
type tprtdat
   obj as integer
endtype

+ Code Snippet

`setup
sync on : sync rate 60
load dll "user32.dll",1
   sw=call dll(1,"GetSystemMetrics",0)
   sh=call dll(1,"GetSystemMetrics",1)
   set display mode sw,sh,32
delete dll 1
hide mouse
backdrop on : color backdrop 0
set camera range 1,0x7fffffff
setupParticles()


`Make a simple boat
make object box 1,50,20,100
make object box 2,10,100,10 : make mesh from object 1,2 : delete object 2
add limb 1,1,1 : offset limb 1,1,0,45,30
delete mesh 1
make mesh from object 1,1
delete object 1
make object 1,1,0
delete mesh 1
color object 1,rgb(128,64,0)

`make sea
make matrix 1,10000,10000,50,50

`Smoke particles
psmoke=addParticles(0,0,0,30,30)
setParticleSize(psmoke,20,20)
colorParticles(psmoke,230,200,200)
setParticleGravity(psmoke,0,5,0)
setParticleAlpha(psmoke,50)

createParticles()

`Main Loop
do

   `control object
   if leftkey() then yrotate object 1,wrapvalue(object angle y(1)-3)
   if rightkey() then yrotate object 1,wrapvalue(object angle y(1)+3)
   a#=object angle y(1)
   if upkey() then move object 1,10
   if downkey() then move object 1,-10
   x#=object position x(1)
   y#=object position y(1)
   z#=object position z(1)

   `camera
   ca#=curveangle(a#,ca#,20.0)
   cx#=x#-(sin(ca#)*600)
   cy#=y#+300
   cz#=z#-(cos(ca#)*600)
   position camera cx#,cy#,cz# : point camera x#,y#,z#

   `Particle data
   prtx#=x#+(sin(a#)*30)+plusmin(rnd(10))
   prty#=95
   prtz#=z#+(cos(a#)*30)+plusmin(rnd(10))
   positionParticles(psmoke,prtx#,prty#,prtz#)

   controlParticles()

sync
loop


function plusmin(num#)
   rand=rnd(10)
   if rand>5 then ret#=num#*-1 else ret#=num#
endfunction ret#

function setupParticles()
   dim prtsys(0) as tprtsys
endfunction
function createParticles()
   count=array count(prtsys())
   cmax=0
   for c=1 to count
      if prtsys(c).count>cmax then cmax=prtsys(c).count
   next c
   dim prtdat(array count(prtsys()),cmax) as tprtdat
   for c=1 to array count(prtsys())
      for o=1 to prtsys(c).count
         prtdat(c,o).obj=val(getToken(prtsys(c).objc,",",o))
      next o
   next c
endfunction count

function addParticles(x#,y#,z#,life,count)
   array insert at bottom prtsys()
   num=array count(prtsys())
   prtsys(num).pos.x=x#+plusmin(rnd(0.2))
   prtsys(num).pos.y=y#+plusmin(rnd(0.2))
   prtsys(num).pos.z=z#+plusmin(rnd(0.2))
   prtsys(num).life=life
   prtsys(num).count=count
   prtsys(num).alpha=100
   for c=1 to prtsys().count
      obj=zp_freeobject() : make object plain obj,20,20
      set object transparency obj,3
      disable object zwrite obj
      position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      obj$=obj$+str$(obj)+","
      lifep=rnd(life)
      life$=life$+str$(lifep)+","
   next c
   prtsys(num).objc=obj$
   prtsys(num).lifep=life$
endfunction num
function setParticleSpeed(num,speed#)
   prtsys(num).speed=speed#
endfunction
function setParticleSize(num,size#,sizep#)
   prtsys(num).sizei=size#
   prtsys(num).sizep=sizep#
   for c=1 to prtsys(num).count
      obj=val(getToken(prtsys(num).objc,",",c))
      scale object obj,size#,size#,1
   next c
endfunction
function setParticleAlpha(num,alpha)
   prtsys(num).alpha=alpha
endfunction
function positionParticles(num,x#,y#,z#)
   prtsys(num).pos.x=x#
   prtsys(num).pos.y=y#
   prtsys(num).pos.z=z#
endfunction
function setParticleGravity(num,x#,y#,z#)
   prtsys(num).grav.x=x#
   prtsys(num).grav.y=y#
   prtsys(num).grav.z=z#
endfunction
function colorParticles(num,r,g,b)
col=rgb(r,g,b)
   for c=1 to prtsys(num).count
      obj=val(getToken(prtsys(num).objc,",",c))
      color object obj,col
   next c
endfunction

function controlParticles()
for num=1 to array count(prtsys())
   for c=1 to prtsys(num).count
      prtsys(num).lifec=prtsys(num).lifec+1
      prtsys(num).lifecount=prtsys(num).life-prtsys(num).lifec
      obj=prtdat(num,c).obj
      angx#=angx#+((360/prtsys(num).count)*c)
      angy#=angy#+((360/prtsys(num).count)*c)
      sx#=object position x(obj)+(sin(angy#)*cos(angx#)*prtsys(num).speed)
      sy#=object position y(obj)-(sin(angx#)*prtsys(num).speed)
      sz#=object position z(obj)+(cos(angy#)*cos(angx#)*prtsys(num).speed)
      sx#=sx#+prtsys(num).grav.x
      sy#=sy#+prtsys(num).grav.y
      sz#=sz#+prtsys(num).grav.z
      size#=prtsys(num).sizei+(prtsys(num).sizep*prtsys(num).lifecount)
      position object obj,sx#,sy#,sz#
      scale object obj,size#,size#,1
      set alpha mapping on obj,prtsys(num).alpha
      if prtsys(num).lifec>prtsys(num).life
         prtsys(num).lifec=prtsys(num).lifec*0
         size#=prtsys(num).sizei
         position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      endif
      set object to camera orientation obj
   next c
next num
endfunction


`Functions
function zp_freeobject()
   repeat
      inc i
   until object exist(i)=0
endfunction i


function getTokens(st$,sp$)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
repeat
   inc counter
   cur$=mid$(nst$,counter)
   if cur$=sp$ then inc splits
until counter>len(nst$)
tokens=splits-1
endfunction tokens
function getToken(st$,sp$,num)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$=sp$ then inc splits
   until splits=num or counter>len(st$)
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$<>sp$ then token$=token$+cur$
   until cur$=sp$ or counter>len(st$)
endfunction token$


`UDTs
type vec3
   x as float
   y as float
   z as float
endtype
type tprtsys
   objc as string
   pos as vec3
   life as integer
   lifec as integer
   lifecount as integer
   lifep as string
   count as integer
   speed as float
   sizei as float
   sizep as float
   alpha as integer
   grav as vec3
endtype
type tprtdat
   obj as integer
endtype

Back to top

Profile PM Email

Sixty Squares

18

Years of Service

User Offline

Joined: 7th Jun 2006

Location: Somewhere in the world

Posted: 16th Dec 2006 23:52 Edited at: 16th Dec 2006 23:56

Link

Wow, that was cool! Reminds me of this, lol. It's something I was going to post but never got around to making the help file for it

Changing "ScaleInterval" to -1 makes the smoke look a little more like fire... If you want me to remove the code from this post I will, if you feel that's it's ruining your thread lol.

[DBPro]

Space makes smoke stop coming out of one of em', I forget which.

ScaleInterval=-1

sync on
sync rate 60
autocam off
randomize Timer()
hide mouse

Dim SQ_Smoke#(1000,19)
Dim SQ_Scale#(30000,2)

Make matrix 1,1000,1000,10,10
position matrix 1,-500,0,-500

SmokeAmount=50
SmokeSize=10
SmokeOverallSize=5

create bitmap 1,100,100
for c = 50 to 1 step -1
R=rnd(255)
ink rgb(R,R,R),0
circle 50,50,c
next c
get image 1,0,0,100,100
delete bitmap 1

create bitmap 1,100,100
for c = 50 to 1 step -1
R=rnd(255)
ink rgb(0,R,R),0
circle 50,50,c
next c
get image 2,0,0,100,100
delete bitmap 1

SQ_CreateSmoke(1,SmokeAmount,SmokeSize,SmokeOverallSize)

SQ_CreateSmoke(2,SmokeAmount*4,SmokeSize,SmokeOverallSize*3)

SQ_PositionSmoke( 2, 100.0 , 0.0 , 0.0 )

SQ_GhostSmokeOn(2)

SQ_TextureSmoke(2,2)

SQ_SetSmokeScaleInt(2,ScaleInterval)
SQ_GhostSmokeOn(1)

SQ_TextureSmoke(1,1)

rem DH=Death Height
SQ_SetSmokeDH(2,3.0)

SQ_SetSmokeRise(2,0.01)

rem Sets how high above the death height the smoke can go before dying.
SQ_SetSmokeDHOffset(1,0.0)

SQ_FadeSmoke(1,300)
SQ_FadeSmoke(2,300)
position camera 0,0,-300

Make object sphere 1,5
make object sphere 2,10

do

if Spacekey() then SQ_StopSmoke(2) else SQ_PlaySmoke(2)
SQ_UpdateSmoke(1)
SQ_OrientSmokeToCamera(1)

SQ_UpdateSmoke(2)
SQ_OrientSmokeToCamera(2)

SQ_PositionSmoke( 1,SQ_SmokePositionX(1)+rightkey()-LEftkey(),Sq_SmokePositionY(1),SQ_SmokePositionz(1) )

SQ_PositionSmoke( 2,SQ_SmokePositionX(2)+Mousemovex()/8,Sq_SmokePositionY(2)+Mousemovey()/-8,SQ_SmokePositionz(1) )

position object 1,SQ_SmokePositionX(1),Sq_SmokePositionY(1),SQ_SmokePositionz(1)

position object 2,SQ_SmokePositionX(2),Sq_SmokePositionY(2),SQ_SmokePositionz(2)

sync
loop

end

function SQ_CreateSmoke(SQ_Num,SQ_Amount,SQ_Size,SQ_OverallSize)
if SQ_Num>1000 then SQ_Num=1000
if SQ_SmokeExist(SQ_Num)=1 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" already exists in "SQ_ResetSmoke"!" : sync : until scancode()>0 : end
   if SQ_Smoke#(SQ_Num,8)=0
      SQ_Smoke#(SQ_Num,2)=0
      SQ_Smoke#(SQ_Num,3)=0
      SQ_Smoke#(SQ_Num,4)=0
      SQ_Smoke#(SQ_Num,5)=0.1
      SQ_Smoke#(SQ_Num,6)=1
      SQ_Smoke#(SQ_Num,7)=SQ_Size
      SQ_Smoke#(SQ_Num,9)=100
      SQ_Smoke#(SQ_Num,8)=1
      SQ_Smoke#(SQ_Num,10)=300
      SQ_Smoke#(SQ_Num,13)=SQ_OverallSize
      SQ_Smoke#(SQ_Num,19)=2

SQ_Begin=SQ_FreeSmokeOBJ()
SQ_YS#=SQ_Smoke#(SQ_Num,5)
      for SQ_o = SQ_Begin to SQ_Begin+SQ_Amount
         if SQ_o>30000 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke amount exceeds maximum in "SQ_CreateSmoke"!" : sync : until scancode()>0 : end
          Make Object Plain SQ_o,SQ_Size,SQ_Size
          position object SQ_o,0,(SQ_YS#-SQ_YS#/2)+SQ_YS#*rnd(30) ,0

SQ_Scale#(SQ_o,1)=100
      next SQ_o

SQ_Smoke#(SQ_Num,11)=SQ_Begin
      SQ_Smoke#(SQ_Num,12)=SQ_Begin+SQ_Amount

endif

for SQ_u = 1 to SQ_Smoke#(SQ_Num,9)*5
   SQ_UpdateSmoke(SQ_Num)
   next SQ_u

SQ_Smoke#(SQ_Num,18)=1
endfunction

function SQ_SetSmokeRise(SQ_Num,SQ_Rise#)
if SQ_SmokeExist(SQ_Num)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SetSmokeRise"!" : sync : until scancode()>0 : end
SQ_Smoke#(SQ_Num,5)=SQ_Rise#
endfunction

function SQ_ResetSmoke(SQ_Num)
if SQ_SmokeExist(SQ_Num)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_ResetSmoke"!" : sync : until scancode()>0 : end
SQ_TY=SQ_Smoke#(SQ_Num,3)
SQ_TZ=SQ_Smoke#(SQ_Num,4)
SQ_Tx=SQ_Smoke#(SQ_Num,2)
SQ_OFF=SQ_Smoke#(SQ_Num,13)/2
SQ_YOFF=SQ_Smoke#(SQ_Num,10)

SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)

for SQ_s = SQ_SSMOKE to SQ_ESMOKE
position object SQ_s,SQ_TX+(-1*SQ_OFF+rnd(SQ_OFF*2)),SQ_TY,SQ_TZ+(-1*SQ_OFF+rnd(SQ_OFF*2)) : SQ_Scale#(SQ_s,1)=100
next SQ_s

endfunction

function SQ_UpdateSmoke(SQ_Num)
if SQ_Num>1000 then SQ_Num=1000
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_UpdateSmoke"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
SQ_YS#=SQ_Smoke#(SQ_Num,5)
SQ_DH=SQ_SMoke#(SQ_Num,9)
SQ_TY=SQ_Smoke#(SQ_Num,3)
SQ_TZ=SQ_Smoke#(SQ_Num,4)
SQ_Tx=SQ_Smoke#(SQ_Num,2)
SQ_OFF=SQ_Smoke#(SQ_Num,13)/2
SQ_YOFF=SQ_Smoke#(SQ_Num,10)
SQ_Stop=SQ_Smoke#(SQ_Num,17)
SQ_ScaleINT=SQ_Smoke#(SQ_Num,19)

for SQ_s = SQ_SSmoke to SQ_ESmoke
SQ_X#=Object position x(SQ_s)
SQ_Y#=Object position y(SQ_s)
SQ_Z#=Object position z(SQ_s)

position object SQ_s,SQ_X#,SQ_Y#+ (SQ_YS#-SQ_YS#/2)+SQ_YS#*rnd(30) ,SQ_Z#
if SQ_Y#>SQ_DH+SQ_Scale#(SQ_s,2)+rnd(SQ_YOFF)

position object SQ_s,SQ_TX+(-1*SQ_OFF+rnd(SQ_OFF*2)),SQ_TY,SQ_TZ+(-1*SQ_OFF+rnd(SQ_OFF*2)) : SQ_Scale#(SQ_s,1)=100 : SQ_Scale#(SQ_s,2)=SQ_TY

if SQ_Stop=1
if SQ_SmokeVisible(SQ_Num)
hide object SQ_s
endif
else
if SQ_SmokeVisible(SQ_Num)
show object SQ_s
endif
endif

endif

SQ_Scale#(SQ_s,1)=SQ_Scale#(SQ_s,1)+SQ_ScaleINT
SQ_NS=SQ_Scale#(SQ_s,1)

Scale Object SQ_s,SQ_NS,SQ_NS,SQ_NS

next SQ_s

endfunction

function SQ_GhostSmokeOn(SQ_Num)
if SQ_SmokeExist(SQ_Num)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_GhostSmokeOn"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
ghost object on SQ_s
next SQ_s
endfunction

function SQ_FadeSmoke(SQ_Num,SQ_FadePower)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_FadeSmoke"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
Fade object SQ_s,SQ_FadePower
next SQ_s
endfunction

function SQ_GhostSmokeOff(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_GhostSmokeOff"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
ghost object off SQ_s
next SQ_s
endfunction

function SQ_TextureSmoke(SQ_Num,SQ_Image)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_TextureSmoke"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
texture object SQ_s,SQ_Image
set object transparency SQ_s,1
next SQ_s
endfunction

function SQ_OrientSmokeToCamera(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_OrientSmokeToCamera"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
set object to camera orientation SQ_s
next SQ_s
endfunction

function SQ_PositionSmoke(SQ_Num,SQ_X#,SQ_Y#,SQ_Z#)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_PositionSmoke"!" : sync : until scancode()>0 : end
SQ_Smoke#(SQ_Num,2)=SQ_X#
SQ_Smoke#(SQ_Num,3)=SQ_Y#
SQ_Smoke#(SQ_Num,4)=SQ_Z#
endfunction

function SQ_SmokePositionX(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SmokePositionX"!" : sync : until scancode()>0 : end
TEMP#=SQ_Smoke#(SQ_Num,2)
endfunction TEMP#

function SQ_SmokePositionY(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SmokePositionY"!" : sync : until scancode()>0 : end
TEMP#=SQ_Smoke#(SQ_Num,3)
endfunction TEMP#

function SQ_SmokePositionZ(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SmokePositionZ"!" : sync : until scancode()>0 : end
TEMP#=SQ_Smoke#(SQ_Num,4)
endfunction TEMP#

function SQ_HideSmoke(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_HideSmoke"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
hide object SQ_s
next SQ_s
SQ_Smoke#(SQ_Num,18)=0
endfunction

function SQ_ShowSmoke(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_ShowSmoke"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
show object SQ_s
next SQ_s
SQ_Smoke#(SQ_Num,18)=1
endfunction

function SQ_FreeSmokeOBJ()
SQ_s=11000
repeat
inc SQ_s
until Object exist(SQ_s)=0 or SQ_s=30000
endfunction SQ_s

function SQ_SetSmokeDH(SQ_Num,SQ_DH#)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SetSmokeDH"!" : sync : until scancode()>0 : end
SQ_Smoke#(SQ_Num,9)=SQ_DH#
endfunction

function SQ_SetSmokeDHOffset(SQ_Num,SQ_DHO#)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SetSmokeDHOffset"!" : sync : until scancode()>0 : end
SQ_Smoke#(SQ_Num,10)=SQ_DHO#
endfunction

function SQ_SmokeExist(SQ_Num)
Temp=SQ_SMoke#(SQ_Num,8)
endfunction Temp

function SQ_FreeSmoke()
sq_s=0
repeat
sq_s=sq_s+1
until SQ_SmokeExist(SQ_s)=0
endfunction SQ_s

function SQ_DeleteSmokeObjects(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_DeleteSmokeObjects"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
delete object SQ_s
next SQ_s
endfunction

function SQ_SetSmokeSize(SQ_Num,SQ_Size#)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SetSmokeSize"!" : sync : until scancode()>0 : end
SQ_Smoke#(SQ_Num,13)=SQ_Size#
endfunction

function SQ_SmokeSize(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SmokeSize"!" : sync : until scancode()>0 : end
Temp#=SQ_Smoke#(SQ_Num,13)
endfunction Temp#

function SQ_SmokeVisible(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SmokeVisible"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
TEMP=SQ_Smoke#(SQ_Num,18)
endfunction TEMP

function SQ_StopSmoke(SQ_Num)
SQ_Smoke#(SQ_Num,17)=1
endfunction

function SQ_PlaySmoke(SQ_Num)
SQ_Smoke#(SQ_Num,17)=0
endfunction

function SQ_SetSmokeScaleInt(SQ_Num,SQ_INT#)
SQ_SMoke#(SQ_Num,19)=SQ_Int#
endfunction

+ Code Snippet

ScaleInterval=-1

sync on
sync rate 60
autocam off
randomize Timer()
hide mouse



Dim SQ_Smoke#(1000,19)
Dim SQ_Scale#(30000,2)

Make matrix 1,1000,1000,10,10
position matrix 1,-500,0,-500

SmokeAmount=50
SmokeSize=10
SmokeOverallSize=5

create bitmap 1,100,100
for c = 50 to 1 step -1
R=rnd(255)
ink rgb(R,R,R),0
circle 50,50,c
next c
get image 1,0,0,100,100
delete bitmap 1

create bitmap 1,100,100
for c = 50 to 1 step -1
R=rnd(255)
ink rgb(0,R,R),0
circle 50,50,c
next c
get image 2,0,0,100,100
delete bitmap 1

SQ_CreateSmoke(1,SmokeAmount,SmokeSize,SmokeOverallSize)



SQ_CreateSmoke(2,SmokeAmount*4,SmokeSize,SmokeOverallSize*3)

SQ_PositionSmoke( 2, 100.0 , 0.0 , 0.0 )

SQ_GhostSmokeOn(2)

SQ_TextureSmoke(2,2)

SQ_SetSmokeScaleInt(2,ScaleInterval)
SQ_GhostSmokeOn(1)

SQ_TextureSmoke(1,1)

rem DH=Death Height
SQ_SetSmokeDH(2,3.0)

SQ_SetSmokeRise(2,0.01)

rem Sets how high above the death height the smoke can go before dying.
SQ_SetSmokeDHOffset(1,0.0)


SQ_FadeSmoke(1,300)
SQ_FadeSmoke(2,300)
position camera 0,0,-300

Make object sphere 1,5
make object sphere 2,10




do

if Spacekey() then SQ_StopSmoke(2) else SQ_PlaySmoke(2)
SQ_UpdateSmoke(1)
SQ_OrientSmokeToCamera(1)

SQ_UpdateSmoke(2)
SQ_OrientSmokeToCamera(2)

SQ_PositionSmoke( 1,SQ_SmokePositionX(1)+rightkey()-LEftkey(),Sq_SmokePositionY(1),SQ_SmokePositionz(1) )

SQ_PositionSmoke( 2,SQ_SmokePositionX(2)+Mousemovex()/8,Sq_SmokePositionY(2)+Mousemovey()/-8,SQ_SmokePositionz(1) )






position object 1,SQ_SmokePositionX(1),Sq_SmokePositionY(1),SQ_SmokePositionz(1)

position object 2,SQ_SmokePositionX(2),Sq_SmokePositionY(2),SQ_SmokePositionz(2)


sync
loop

























end







function SQ_CreateSmoke(SQ_Num,SQ_Amount,SQ_Size,SQ_OverallSize)
if SQ_Num>1000 then SQ_Num=1000
if SQ_SmokeExist(SQ_Num)=1 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" already exists in "SQ_ResetSmoke"!" : sync : until scancode()>0 : end
   if SQ_Smoke#(SQ_Num,8)=0
      SQ_Smoke#(SQ_Num,2)=0
      SQ_Smoke#(SQ_Num,3)=0
      SQ_Smoke#(SQ_Num,4)=0
      SQ_Smoke#(SQ_Num,5)=0.1
      SQ_Smoke#(SQ_Num,6)=1
      SQ_Smoke#(SQ_Num,7)=SQ_Size
      SQ_Smoke#(SQ_Num,9)=100
      SQ_Smoke#(SQ_Num,8)=1
      SQ_Smoke#(SQ_Num,10)=300
      SQ_Smoke#(SQ_Num,13)=SQ_OverallSize
      SQ_Smoke#(SQ_Num,19)=2

      SQ_Begin=SQ_FreeSmokeOBJ()
SQ_YS#=SQ_Smoke#(SQ_Num,5)
      for SQ_o = SQ_Begin to SQ_Begin+SQ_Amount
         if SQ_o>30000 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke amount exceeds maximum in "SQ_CreateSmoke"!" : sync : until scancode()>0 : end
          Make Object Plain SQ_o,SQ_Size,SQ_Size
          position object SQ_o,0,(SQ_YS#-SQ_YS#/2)+SQ_YS#*rnd(30) ,0

         SQ_Scale#(SQ_o,1)=100
      next SQ_o

      SQ_Smoke#(SQ_Num,11)=SQ_Begin
      SQ_Smoke#(SQ_Num,12)=SQ_Begin+SQ_Amount

   endif

   for SQ_u = 1 to SQ_Smoke#(SQ_Num,9)*5
   SQ_UpdateSmoke(SQ_Num)
   next SQ_u

   SQ_Smoke#(SQ_Num,18)=1
endfunction




function SQ_SetSmokeRise(SQ_Num,SQ_Rise#)
if SQ_SmokeExist(SQ_Num)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SetSmokeRise"!" : sync : until scancode()>0 : end
SQ_Smoke#(SQ_Num,5)=SQ_Rise#
endfunction


function SQ_ResetSmoke(SQ_Num)
if SQ_SmokeExist(SQ_Num)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_ResetSmoke"!" : sync : until scancode()>0 : end
SQ_TY=SQ_Smoke#(SQ_Num,3)
SQ_TZ=SQ_Smoke#(SQ_Num,4)
SQ_Tx=SQ_Smoke#(SQ_Num,2)
SQ_OFF=SQ_Smoke#(SQ_Num,13)/2
SQ_YOFF=SQ_Smoke#(SQ_Num,10)

SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)

for SQ_s = SQ_SSMOKE to SQ_ESMOKE
position object SQ_s,SQ_TX+(-1*SQ_OFF+rnd(SQ_OFF*2)),SQ_TY,SQ_TZ+(-1*SQ_OFF+rnd(SQ_OFF*2)) : SQ_Scale#(SQ_s,1)=100
next SQ_s

endfunction


function SQ_UpdateSmoke(SQ_Num)
if SQ_Num>1000 then SQ_Num=1000
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_UpdateSmoke"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
SQ_YS#=SQ_Smoke#(SQ_Num,5)
SQ_DH=SQ_SMoke#(SQ_Num,9)
SQ_TY=SQ_Smoke#(SQ_Num,3)
SQ_TZ=SQ_Smoke#(SQ_Num,4)
SQ_Tx=SQ_Smoke#(SQ_Num,2)
SQ_OFF=SQ_Smoke#(SQ_Num,13)/2
SQ_YOFF=SQ_Smoke#(SQ_Num,10)
SQ_Stop=SQ_Smoke#(SQ_Num,17)
SQ_ScaleINT=SQ_Smoke#(SQ_Num,19)


for SQ_s = SQ_SSmoke to SQ_ESmoke
SQ_X#=Object position x(SQ_s)
SQ_Y#=Object position y(SQ_s)
SQ_Z#=Object position z(SQ_s)




position object SQ_s,SQ_X#,SQ_Y#+ (SQ_YS#-SQ_YS#/2)+SQ_YS#*rnd(30) ,SQ_Z#
if SQ_Y#>SQ_DH+SQ_Scale#(SQ_s,2)+rnd(SQ_YOFF)

position object SQ_s,SQ_TX+(-1*SQ_OFF+rnd(SQ_OFF*2)),SQ_TY,SQ_TZ+(-1*SQ_OFF+rnd(SQ_OFF*2)) : SQ_Scale#(SQ_s,1)=100 : SQ_Scale#(SQ_s,2)=SQ_TY

if SQ_Stop=1
if SQ_SmokeVisible(SQ_Num)
hide object SQ_s
endif
else
if SQ_SmokeVisible(SQ_Num)
show object SQ_s
endif
endif


endif

SQ_Scale#(SQ_s,1)=SQ_Scale#(SQ_s,1)+SQ_ScaleINT
SQ_NS=SQ_Scale#(SQ_s,1)

Scale Object SQ_s,SQ_NS,SQ_NS,SQ_NS

next SQ_s


endfunction



function SQ_GhostSmokeOn(SQ_Num)
if SQ_SmokeExist(SQ_Num)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_GhostSmokeOn"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
ghost object on SQ_s
next SQ_s
endfunction


function SQ_FadeSmoke(SQ_Num,SQ_FadePower)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_FadeSmoke"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
Fade object SQ_s,SQ_FadePower
next SQ_s
endfunction


function SQ_GhostSmokeOff(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_GhostSmokeOff"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
ghost object off SQ_s
next SQ_s
endfunction



function SQ_TextureSmoke(SQ_Num,SQ_Image)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_TextureSmoke"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
texture object SQ_s,SQ_Image
set object transparency SQ_s,1
next SQ_s
endfunction

function SQ_OrientSmokeToCamera(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_OrientSmokeToCamera"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
set object to camera orientation SQ_s
next SQ_s
endfunction



function SQ_PositionSmoke(SQ_Num,SQ_X#,SQ_Y#,SQ_Z#)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_PositionSmoke"!" : sync : until scancode()>0 : end
SQ_Smoke#(SQ_Num,2)=SQ_X#
SQ_Smoke#(SQ_Num,3)=SQ_Y#
SQ_Smoke#(SQ_Num,4)=SQ_Z#
endfunction



function SQ_SmokePositionX(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SmokePositionX"!" : sync : until scancode()>0 : end
TEMP#=SQ_Smoke#(SQ_Num,2)
endfunction TEMP#

function SQ_SmokePositionY(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SmokePositionY"!" : sync : until scancode()>0 : end
TEMP#=SQ_Smoke#(SQ_Num,3)
endfunction TEMP#

function SQ_SmokePositionZ(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SmokePositionZ"!" : sync : until scancode()>0 : end
TEMP#=SQ_Smoke#(SQ_Num,4)
endfunction TEMP#


function SQ_HideSmoke(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_HideSmoke"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
hide object SQ_s
next SQ_s
SQ_Smoke#(SQ_Num,18)=0
endfunction

function SQ_ShowSmoke(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_ShowSmoke"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
show object SQ_s
next SQ_s
SQ_Smoke#(SQ_Num,18)=1
endfunction


function SQ_FreeSmokeOBJ()
SQ_s=11000
repeat
inc SQ_s
until Object exist(SQ_s)=0 or SQ_s=30000
endfunction SQ_s



function SQ_SetSmokeDH(SQ_Num,SQ_DH#)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SetSmokeDH"!" : sync : until scancode()>0 : end
SQ_Smoke#(SQ_Num,9)=SQ_DH#
endfunction


function SQ_SetSmokeDHOffset(SQ_Num,SQ_DHO#)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SetSmokeDHOffset"!" : sync : until scancode()>0 : end
SQ_Smoke#(SQ_Num,10)=SQ_DHO#
endfunction

function SQ_SmokeExist(SQ_Num)
Temp=SQ_SMoke#(SQ_Num,8)
endfunction Temp

function SQ_FreeSmoke()
sq_s=0
repeat
sq_s=sq_s+1
until SQ_SmokeExist(SQ_s)=0
endfunction SQ_s

function SQ_DeleteSmokeObjects(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_DeleteSmokeObjects"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
SQ_ESmoke=SQ_Smoke#(SQ_Num,12)
for SQ_s = SQ_SSMOKE to SQ_ESMOKE
delete object SQ_s
next SQ_s
endfunction


function SQ_SetSmokeSize(SQ_Num,SQ_Size#)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SetSmokeSize"!" : sync : until scancode()>0 : end
SQ_Smoke#(SQ_Num,13)=SQ_Size#
endfunction

function SQ_SmokeSize(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SmokeSize"!" : sync : until scancode()>0 : end
Temp#=SQ_Smoke#(SQ_Num,13)
endfunction Temp#

function SQ_SmokeVisible(SQ_Num)
if SQ_Smoke#(SQ_Num,8)=0 then Repeat : ink rgb(255,155,155),0 : Set Text Size 16 : set text font "" : Center Text Screen Width()/2,Screen Height()/2, "Smoke "+str$(SQ_Num)+" does not exist in "SQ_SmokeVisible"!" : sync : until scancode()>0 : end
SQ_SSmoke=SQ_Smoke#(SQ_Num,11)
TEMP=SQ_Smoke#(SQ_Num,18)
endfunction TEMP

function SQ_StopSmoke(SQ_Num)
SQ_Smoke#(SQ_Num,17)=1
endfunction

function SQ_PlaySmoke(SQ_Num)
SQ_Smoke#(SQ_Num,17)=0
endfunction

function SQ_SetSmokeScaleInt(SQ_Num,SQ_INT#)
SQ_SMoke#(SQ_Num,19)=SQ_Int#
endfunction

Back to top

Profile PM Email

Zotoaster

19

Years of Service

User Offline

Joined: 20th Dec 2004

Location: Scotland

Posted: 17th Dec 2006 00:16

Link

That's some really good code there

Back to top

Profile PM Email

Sixty Squares

18

Years of Service

User Offline

Joined: 7th Jun 2006

Location: Somewhere in the world

Posted: 17th Dec 2006 01:00 Edited at: 17th Dec 2006 01:04

Link

Thank you. It works in DBC if I change "set object transparency" to "Set object" ^^ In fact was originally written for DBC and the functions will work in any game if you can figure out what each does from my example lol. Anyway enough about that back to your thread

I liked how the "little... thing" would run away from the mouse in the first one and how it would bounce. I played with that for like 3 mins lol

Back to top

Profile PM Email

Zotoaster

19

Years of Service

User Offline

Joined: 20th Dec 2004

Location: Scotland

Posted: 17th Dec 2006 02:08

Link

Haha yeah.

Here's another very slight variation of the demo everyone's bored of

Looks like a galaxy - a very colourfull one

`setup
sync on : sync rate 60
load dll "user32.dll",1
   sw=call dll(1,"GetSystemMetrics",0)
   sh=call dll(1,"GetSystemMetrics",1)
   set display mode sw,sh,32
delete dll 1
hide mouse
backdrop on : color backdrop 0
set camera range 1,6000

`Ball data
ox#=screen width()/2 : oy#=screen height()/2
mass#=100 : radius=10
indent=100
camdist#=2500

`Create Particles
life=60
count=life
size#=180 : sized#=size#/life
setupParticles()
prt1=addParticles(0,0,0,life,count)
setParticleSize(prt1,size#,-sized#)
colorParticles(prt1,255,0,0)
prt2=addParticles(0,0,0,life,count)
setParticleSize(prt2,size#,-sized#)
colorParticles(prt2,0,255,0)
prt3=addParticles(0,0,0,life,count)
setParticleSize(prt3,size#,-sized#)
colorParticles(prt3,0,0,255)
prt4=addParticles(0,0,0,life,count)
setParticleSize(prt4,size#,-sized#)
colorParticles(prt4,255,255,0)
prt5=addParticles(0,0,0,life,count)
setParticleSize(prt5,size#,-sized#)

pball=addParticles(0,0,0,30,30)
setParticleSize(pball,60,-2)
colorParticles(pball,0,128,250)

for p=1 to getEmitterCount()
   setParticleGhost(p,1)
next p

createParticles()

`Mode
mode=1

`Main Loop
do

if mode=1
      pick screen mousex(),mousey(),camdist#
      px#=get pick vector x()+plusmin(rnd(15))
      py#=get pick vector y()+plusmin(rnd(15))
      pz#=get pick vector z()+plusmin(rnd(15))
   else
      pick screen (screen width()/2)+plusmin(rnd(screen width()/2)),screen height(),camdist#
      px#=get pick vector x()
      py#=get pick vector y()
      pz#=get pick vector z()
   endif

positionParticles(prt1,px#,py#,pz#)
   positionParticles(prt2,px#,py#,pz#)
   positionParticles(prt3,px#,py#,pz#)
   positionParticles(prt4,px#,py#,pz#)
   positionParticles(prt5,px#,py#,pz#)
   ang#=wrapvalue(ang#+2) : grav#=(6*(mouseclick()+1))
   for p=prt1 to prt4
      setParticleGravity(p,sin(ang#+(p*90))*grav#,(cos(ang#+(p*90))*grav#)+(grav#*(1-mode)),0)
   next p
   setParticleGravity(prt5,0,(grav#*(1-mode)),0)

dist#=sqrt((mousex()-ox#)^2+(mousey()-oy#)^2)
   omang#=atanfull(mousex()-ox#,mousey()-oy#)
   frc#=-((mass#*radius)/dist#)*2
   frcx#=sin(omang#)*frc#
   frcy#=cos(omang#)*frc#
   accx#=frcx#/mass#
   accy#=frcy#/mass#
   spdx#=spdx#+accx#
   spdy#=spdy#+accy#
   ox#=ox#+spdx#
   oy#=oy#+spdy#
   spdx#=spdx#*0.98
   spdy#=spdy#*0.98
   if ox#<=indent then spdx#=0-spdx#
   if oy#<=indent then spdy#=0-spdy#
   if ox#>=screen width()-indent then spdx#=0-spdx#
   if oy#>=screen height()-indent then spdy#=0-spdy#

pick screen ox#,oy#,camdist#
   bx#=get pick vector x()
   by#=get pick vector y()
   bz#=get pick vector z()
   positionParticles(pball,bx#,by#,bz#)

controlParticles()

ink rgb(255,255,255),0
   line indent,indent,indent,screen height()-indent
   line indent,indent,screen width()-indent,indent
   line indent,screen height()-indent,screen width()-indent,screen height()-indent
   line screen width()-indent,indent,screen width()-indent,screen height()-indent
   text 10,screen height()-30,"fps: "+str$(screen fps())

sync
loop

function plusmin(num#)
   rand=rnd(10)
   if rand>5 then ret#=num#*-1 else ret#=num#
endfunction ret#

function setupParticles()
   dim prtsys(0) as tprtsys
endfunction
function createParticles()
   count=array count(prtsys())
   cmax=0
   for c=1 to count
      if prtsys(c).count>cmax then cmax=prtsys(c).count
   next c
   dim prtdat(array count(prtsys()),cmax) as tprtdat
   for c=1 to array count(prtsys())
      for o=1 to prtsys(c).count
         prtdat(c,o).obj=val(getToken(prtsys(c).objc,",",o))
      next o
   next c
endfunction count

function addParticles(x#,y#,z#,life,count)
   array insert at bottom prtsys()
   num=array count(prtsys())
   prtsys(num).pos.x=x#+plusmin(rnd(0.2))
   prtsys(num).pos.y=y#+plusmin(rnd(0.2))
   prtsys(num).pos.z=z#+plusmin(rnd(0.2))
   prtsys(num).life=life
   prtsys(num).count=count
   for c=1 to prtsys().count
      obj=zp_freeobject() : make object plain obj,100,100
      set object transparency obj,3
      disable object zwrite obj
      position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      obj$=obj$+str$(obj)+","
      lifep=rnd(life)
      life$=life$+str$(lifep)+","
   next c
   prtsys(num).objc=obj$
   prtsys(num).lifep=life$
endfunction num
function setParticleSpeed(num,speed#)
   prtsys(num).speed=speed#
endfunction
function setParticleSize(num,size#,sizep#)
      prtsys(num).sizei=size#
      prtsys(num).sizep=sizep#
      for c=1 to prtsys(num).count
         obj=val(getToken(prtsys(num).objc,",",c))
         scale object obj,size#,size#,1
      next c
endfunction
function positionParticles(num,x#,y#,z#)
   prtsys(num).pos.x=x#
   prtsys(num).pos.y=y#
   prtsys(num).pos.z=z#
endfunction
function setParticleGravity(num,x#,y#,z#)
   prtsys(num).grav.x=x#
   prtsys(num).grav.y=y#
   prtsys(num).grav.z=z#
endfunction
function colorParticles(num,r,g,b)
col=rgb(r,g,b)
      for c=1 to prtsys(num).count
         obj=val(getToken(prtsys(num).objc,",",c))
         color object obj,col
      next c
endfunction
function setParticleGhost(num,flag)
      for c=1 to prtsys(num).count
         obj=val(getToken(prtsys(num).objc,",",c))
         if flag=1
            ghost object on obj
         else
            ghost object off obj
         endif
      next c
endfunction

function controlParticles()
for num=1 to array count(prtsys())
   for c=1 to prtsys(num).count
      prtsys(num).lifec=prtsys(num).lifec+1
      prtsys(num).lifecount=prtsys(num).life-prtsys(num).lifec
      obj=prtdat(num,c).obj
      angx#=angx#+((360/prtsys(num).count)*c)
      angy#=angy#+((360/prtsys(num).count)*c)
      sx#=object position x(obj)+(sin(angy#)*cos(angx#)*prtsys(num).speed)
      sy#=object position y(obj)-(sin(angx#)*prtsys(num).speed)
      sz#=object position z(obj)+(cos(angy#)*cos(angx#)*prtsys(num).speed)
      sx#=sx#+prtsys(num).grav.x
      sy#=sy#+prtsys(num).grav.y
      sz#=sz#+prtsys(num).grav.z
      size#=prtsys(num).sizei+(prtsys(num).sizep*prtsys(num).lifecount)
      position object obj,sx#,sy#,sz#
      scale object obj,size#,size#,1
      if prtsys(num).lifec>prtsys(num).life
         prtsys(num).lifec=prtsys(num).lifec*0
         size#=prtsys(num).sizei
         position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      endif
   next c
next num
endfunction

function getEmitterCount()
   count=array count(prtsys())
endfunction count
function getParticleCount(num)
   count=prtsys(num).count
endfunction count

`Functions
function zp_freeobject()
   repeat
      inc i
   until object exist(i)=0
endfunction i

function getTokens(st$,sp$)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
repeat
   inc counter
   cur$=mid$(nst$,counter)
   if cur$=sp$ then inc splits
until counter>len(nst$)
tokens=splits-1
endfunction tokens
function getToken(st$,sp$,num)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$=sp$ then inc splits
   until splits=num or counter>len(st$)
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$<>sp$ then token$=token$+cur$
   until cur$=sp$ or counter>len(st$)
endfunction token$

`UDTs
type vec3
   x as float
   y as float
   z as float
endtype
type tprtsys
   objc as string
   pos as vec3
   life as integer
   lifec as integer
   lifecount as integer
   lifep as string
   count as integer
   speed as float
   sizei as float
   sizep as float
   grav as vec3
endtype
type tprtdat
   obj as integer
endtype

+ Code Snippet

`setup
sync on : sync rate 60
load dll "user32.dll",1
   sw=call dll(1,"GetSystemMetrics",0)
   sh=call dll(1,"GetSystemMetrics",1)
   set display mode sw,sh,32
delete dll 1
hide mouse
backdrop on : color backdrop 0
set camera range 1,6000

`Ball data
ox#=screen width()/2 : oy#=screen height()/2
mass#=100 : radius=10
indent=100
camdist#=2500

`Create Particles
life=60
count=life
size#=180 : sized#=size#/life
setupParticles()
prt1=addParticles(0,0,0,life,count)
setParticleSize(prt1,size#,-sized#)
colorParticles(prt1,255,0,0)
prt2=addParticles(0,0,0,life,count)
setParticleSize(prt2,size#,-sized#)
colorParticles(prt2,0,255,0)
prt3=addParticles(0,0,0,life,count)
setParticleSize(prt3,size#,-sized#)
colorParticles(prt3,0,0,255)
prt4=addParticles(0,0,0,life,count)
setParticleSize(prt4,size#,-sized#)
colorParticles(prt4,255,255,0)
prt5=addParticles(0,0,0,life,count)
setParticleSize(prt5,size#,-sized#)

pball=addParticles(0,0,0,30,30)
setParticleSize(pball,60,-2)
colorParticles(pball,0,128,250)

for p=1 to getEmitterCount()
   setParticleGhost(p,1)
next p

createParticles()


`Mode
mode=1

`Main Loop
do

   if mode=1
      pick screen mousex(),mousey(),camdist#
      px#=get pick vector x()+plusmin(rnd(15))
      py#=get pick vector y()+plusmin(rnd(15))
      pz#=get pick vector z()+plusmin(rnd(15))
   else
      pick screen (screen width()/2)+plusmin(rnd(screen width()/2)),screen height(),camdist#
      px#=get pick vector x()
      py#=get pick vector y()
      pz#=get pick vector z()
   endif

   positionParticles(prt1,px#,py#,pz#)
   positionParticles(prt2,px#,py#,pz#)
   positionParticles(prt3,px#,py#,pz#)
   positionParticles(prt4,px#,py#,pz#)
   positionParticles(prt5,px#,py#,pz#)
   ang#=wrapvalue(ang#+2) : grav#=(6*(mouseclick()+1))
   for p=prt1 to prt4
      setParticleGravity(p,sin(ang#+(p*90))*grav#,(cos(ang#+(p*90))*grav#)+(grav#*(1-mode)),0)
   next p
   setParticleGravity(prt5,0,(grav#*(1-mode)),0)

   dist#=sqrt((mousex()-ox#)^2+(mousey()-oy#)^2)
   omang#=atanfull(mousex()-ox#,mousey()-oy#)
   frc#=-((mass#*radius)/dist#)*2
   frcx#=sin(omang#)*frc#
   frcy#=cos(omang#)*frc#
   accx#=frcx#/mass#
   accy#=frcy#/mass#
   spdx#=spdx#+accx#
   spdy#=spdy#+accy#
   ox#=ox#+spdx#
   oy#=oy#+spdy#
   spdx#=spdx#*0.98
   spdy#=spdy#*0.98
   if ox#<=indent then spdx#=0-spdx#
   if oy#<=indent then spdy#=0-spdy#
   if ox#>=screen width()-indent then spdx#=0-spdx#
   if oy#>=screen height()-indent then spdy#=0-spdy#

   pick screen ox#,oy#,camdist#
   bx#=get pick vector x()
   by#=get pick vector y()
   bz#=get pick vector z()
   positionParticles(pball,bx#,by#,bz#)

   controlParticles()

   ink rgb(255,255,255),0
   line indent,indent,indent,screen height()-indent
   line indent,indent,screen width()-indent,indent
   line indent,screen height()-indent,screen width()-indent,screen height()-indent
   line screen width()-indent,indent,screen width()-indent,screen height()-indent
   text 10,screen height()-30,"fps: "+str$(screen fps())

sync
loop


function plusmin(num#)
   rand=rnd(10)
   if rand>5 then ret#=num#*-1 else ret#=num#
endfunction ret#

function setupParticles()
   dim prtsys(0) as tprtsys
endfunction
function createParticles()
   count=array count(prtsys())
   cmax=0
   for c=1 to count
      if prtsys(c).count>cmax then cmax=prtsys(c).count
   next c
   dim prtdat(array count(prtsys()),cmax) as tprtdat
   for c=1 to array count(prtsys())
      for o=1 to prtsys(c).count
         prtdat(c,o).obj=val(getToken(prtsys(c).objc,",",o))
      next o
   next c
endfunction count

function addParticles(x#,y#,z#,life,count)
   array insert at bottom prtsys()
   num=array count(prtsys())
   prtsys(num).pos.x=x#+plusmin(rnd(0.2))
   prtsys(num).pos.y=y#+plusmin(rnd(0.2))
   prtsys(num).pos.z=z#+plusmin(rnd(0.2))
   prtsys(num).life=life
   prtsys(num).count=count
   for c=1 to prtsys().count
      obj=zp_freeobject() : make object plain obj,100,100
      set object transparency obj,3
      disable object zwrite obj
      position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      obj$=obj$+str$(obj)+","
      lifep=rnd(life)
      life$=life$+str$(lifep)+","
   next c
   prtsys(num).objc=obj$
   prtsys(num).lifep=life$
endfunction num
function setParticleSpeed(num,speed#)
   prtsys(num).speed=speed#
endfunction
function setParticleSize(num,size#,sizep#)
      prtsys(num).sizei=size#
      prtsys(num).sizep=sizep#
      for c=1 to prtsys(num).count
         obj=val(getToken(prtsys(num).objc,",",c))
         scale object obj,size#,size#,1
      next c
endfunction
function positionParticles(num,x#,y#,z#)
   prtsys(num).pos.x=x#
   prtsys(num).pos.y=y#
   prtsys(num).pos.z=z#
endfunction
function setParticleGravity(num,x#,y#,z#)
   prtsys(num).grav.x=x#
   prtsys(num).grav.y=y#
   prtsys(num).grav.z=z#
endfunction
function colorParticles(num,r,g,b)
col=rgb(r,g,b)
      for c=1 to prtsys(num).count
         obj=val(getToken(prtsys(num).objc,",",c))
         color object obj,col
      next c
endfunction
function setParticleGhost(num,flag)
      for c=1 to prtsys(num).count
         obj=val(getToken(prtsys(num).objc,",",c))
         if flag=1
            ghost object on obj
         else
            ghost object off obj
         endif
      next c
endfunction

function controlParticles()
for num=1 to array count(prtsys())
   for c=1 to prtsys(num).count
      prtsys(num).lifec=prtsys(num).lifec+1
      prtsys(num).lifecount=prtsys(num).life-prtsys(num).lifec
      obj=prtdat(num,c).obj
      angx#=angx#+((360/prtsys(num).count)*c)
      angy#=angy#+((360/prtsys(num).count)*c)
      sx#=object position x(obj)+(sin(angy#)*cos(angx#)*prtsys(num).speed)
      sy#=object position y(obj)-(sin(angx#)*prtsys(num).speed)
      sz#=object position z(obj)+(cos(angy#)*cos(angx#)*prtsys(num).speed)
      sx#=sx#+prtsys(num).grav.x
      sy#=sy#+prtsys(num).grav.y
      sz#=sz#+prtsys(num).grav.z
      size#=prtsys(num).sizei+(prtsys(num).sizep*prtsys(num).lifecount)
      position object obj,sx#,sy#,sz#
      scale object obj,size#,size#,1
      if prtsys(num).lifec>prtsys(num).life
         prtsys(num).lifec=prtsys(num).lifec*0
         size#=prtsys(num).sizei
         position object obj,prtsys(num).pos.x,prtsys(num).pos.y,prtsys(num).pos.z
      endif
   next c
next num
endfunction

function getEmitterCount()
   count=array count(prtsys())
endfunction count
function getParticleCount(num)
   count=prtsys(num).count
endfunction count


`Functions
function zp_freeobject()
   repeat
      inc i
   until object exist(i)=0
endfunction i


function getTokens(st$,sp$)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
repeat
   inc counter
   cur$=mid$(nst$,counter)
   if cur$=sp$ then inc splits
until counter>len(nst$)
tokens=splits-1
endfunction tokens
function getToken(st$,sp$,num)
if left$(st$,1)<>sp$ then nst$=sp$+st$
if right$(st$,1)<>sp$ then nst$=nst$+sp$
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$=sp$ then inc splits
   until splits=num or counter>len(st$)
   repeat
      inc counter
      cur$=mid$(nst$,counter)
      if cur$<>sp$ then token$=token$+cur$
   until cur$=sp$ or counter>len(st$)
endfunction token$


`UDTs
type vec3
   x as float
   y as float
   z as float
endtype
type tprtsys
   objc as string
   pos as vec3
   life as integer
   lifec as integer
   lifecount as integer
   lifep as string
   count as integer
   speed as float
   sizei as float
   sizep as float
   grav as vec3
endtype
type tprtdat
   obj as integer
endtype

Back to top

Profile PM Email

Sorry your browser is not supported!

Code Snippets / Good particle system