'$ 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

def stride
  @%1+=sizeof %1
end def


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

float x,y                  'POSITION
float xv,yv                'VELOCITY
float ra                   'RADIUS
sys   bou,mark             'STATE FLAGS
byte  red,green,blue,alpha 'COLOR

method constructor()
  'ASSIGN RANDOMISED VALUES
  single r,a
  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(12,16)
  red   = rand(0,60)
  green = rand(100,250)
  blue  = rand(160,250)
  bou   = 0
  mark  = 0
end method

method destructor()
end method

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

method setmark(sys a)
  mark=a
end method

method move()
  x += xv
  y += yv
end method

method bounce()
  sys c
  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 render()
  float sz=ra*1.5
  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

end class


'==============
class Particles
'==============
  '
  sys    popn  'NUMBER OF UNITS
  sys    sbuf  'BUFFER CONTAINING UNITS

method constructor(sys e)
  sys i,b
  popn=e
  sbuf=getmemory e*sizeof UnitParticle
  unitParticle * p = sbuf
  for i=0 to <e
    p.constructor
    stride p
  next
end method

method destructor()
  freememory sbuf
  popn=0
  sbuf=0
end method

method MergeContact(unitParticle*p)
  unitParticle *q = sbuf
  float c,d,g
  sys j,e=popn-1
  if p.bou=0 then return 0 'no interaction
  if p.mark then return 0  'eaten
  '
  for j=0 to e
  if @q>@p then
    if q.mark=0 and q.bou=1
     d=hypot(p.x-q.x, p.y-q.y)
     c=p.ra+q.ra
     if d<c then
      g=hypot( p.ra, q.ra )
      if p.ra>=q.ra then
       q.mark=1 'off field
       p.ra=g   'grow
      else 
       p.mark=1 'off field
       q.ra=g   'grow
      end if
      exit for 'first encounter only
     end if
    end if
   end if
   stride q
  next
end method

method progeny(unitParticle*p)
  sys j,c,q
  sys e=popn-1
  unitParticle *q = sbuf
  if p.bou=0 or p.mark=1 then return
  if p.ra>50 then 'size threshhold
   for j=0 to e
    if @p<>@q
     if q.mark then
      c++
      if c >30 then exit for 'limit progeny
      q.constructor 'RECYCLED
      q.x=p.x : q.y=p.y
      p.ra=10 'remaining size after giving birth
     end if 
    end if
    stride q
   next
  end if
end method

method act()
  sys i
  sys e=popn-1
  unitParticle *p = sbuf
  for i=0 to e
    p.move
    if p.outside then
      p.bounce
    end if
    progeny p
    mergeContact p
    p.render
    stride p
  next
end method

end class

'MAIN
new particles pa(anzahl)
While Key(27)=0
ClsColor 80,0,0
pa.act
Events
FlipBuffer
WaitFPS 80
Wend
del pa

WinEnd

