'$ filename "t.exe"
'include "$\inc\RTL32.inc"
include "..\GDIWindow\window.inc"
Window "Consume Grow and Multiply", 640, 480, 2
sys xscreen =640, yscreen =480, i, sz
'Font 12,24,0,"courier"
sys anzahl=300

single xmitte = xscreen/2, ymitte = yscreen/2

'=================
class UnitParticle
'=================

single x,y,xv,yv,ra
sys    sz,bou,mark
byte   red,green,blue,alpha

end class


'==============
class Particles
'==============

  UnitParticle
  '
  '
  'BASE PARTICLE ONLY
  '
  sys    pob,popn
  string sbuf

method index(sys i)
  pob=strptr(sbuf)+i*sizeof UnitParticle
end method

method populate(sys e)
  sys i,b
  popn=e
  sbuf=nuls e*sizeof UnitParticle
  pob=strptr sbuf
  for i=0 to <e
    rebirth
    pob+=sizeof UnitParticle
  next
end method

method rebirth()
  single r,a
  @this = pob
  x     = xmitte
  y     = ymitte
  a     = rand(1,628)*.01
  r     = rand(20,100)*.02
  xv    = r*cos(a)*.5
  yv    = r*sin(a)*.5
  ra    = rand(9,12)
  red   = rand(0,60)
  green = rand(100,250)
  blue  = rand(160,250)
  bou   = 0
  mark  = 0
end method

method outside() as sys
  @this=pob
  if x<0 or y<0 or x>=xscreen or y>=yscreen then return 1
end method

method MergeContact(sys j) as sys
  sys k=strptr sbuf
  particles *p
  float c,g
  sys i,e=popn-1
  @this=pob
  if bou=0 then return 0 'no interaction
  if mark then return 0
  '
   for i=0 to e
   if i<>j
    @p=k+i*sizeof UnitParticle
    if p.mark=0 and p.bou=1
     c=hypot(x-p.x, y-p.y)
     if c<ra then
      g=hypot( ra, p.ra )
      if ra>=p.ra then
       p.mark=1 'off field
       ra=g     'grow
      else 
       mark=1   'off field
       p.ra=g   'grow
       exit for 'early exit
      end if
     end if
    end if
   end if
  next
end method

method progeny(sys j)
  sys i,c,q
  sys id=@this, e=popn-1, k=strptr sbuf
  @this=pob
  particles *p
  if bou=0 or mark=1 then return
  if ra>50 then 'size threshhold
   for i=0 to e
    if i<>j
     @p=k+i*sizeof UnitParticle
     if p.mark then
      c++
      if c >30 then exit for 'limit progeny
      @this=id
      q=pob
      pob=@p
      rebirth
      pob=q
      @this=pob
      p.x=x : p.y=y
      ra=10 'remaining size after giving birth
     end if 
    end if
   next
  end if
end method

method setmark(sys a)
  @this=pob
  mark=a
end method

method move()
  @this=pob
  x += xv
  y += yv
  sz=ra*2
end method

method bounce()
  sys c
  @this=pob
  if x>=xscreen
    xv=-xv : x=xscreen-1 : c=1
  elseif x<=0
    xv=-xv : x=1 : c=2
  end if
  if y>=yscreen
    yv=-yv : y=yscreen-1 : c=3
  elseif y<=0
    yv=-yv : y=1 : c=4
  end if
  if c
    bou=1 'activate
  end if
end method

method show()
  @this=pob
  if bou=0 then
    Oval x-ra, y-ra, sz, sz, 0, red+120, 0
  else
    Oval x-ra, y-ra, sz, sz, red, green, blue
  end if
end method

method act(sys i)
  index i
  move
  if outside then
    bounce
  end if
  progeny i
  MergeContact i
  show
end method

end class

sys c
particles pa
pa.populate anzahl


While Key(27)=0
ClsColor 80,0,0
for i=0 to <anzahl
  pa.act i
next
Events
FlipBuffer
WaitFPS 80
Wend
WinEnd

