[ulis], 2004-03-17. Yet an other Life simulation.

Modified 2004-03-18: I forgot to free the resources of a bug object at its death.

[http://perso.wanadoo.fr/maurice.ulis/tcl/bugs.png]

----

'''Bugs stuff'''

======
  # -------------
  # bugs stuff
  # -------------

  proc food:birth {} \
  {
    variable {}
    # create a food
    set x [expr {round($(xmax) * rand())}]
    set y [expr {round($(ymax) * rand())}]
    # give it a nutritional value
    set (food:$x:$y) $(food)
    # display it
    .c create rectangle $x $y $x $y -tags f:$x:$y -outline linen
    .c lower f:$x:$y
    update
  }
  proc food:death {x y} \
  {
    variable {}
    # remove the food from existence
    unset (food:$x:$y)
    # remove the food from the box
    .c delete f:$x:$y
    update
  }
  proc bug:birth {args} \
  {
    variable {}
    # pick an ID
    set bug [incr (bugID)]
    # add the bug to its population
    lappend (bugs) $bug
    # inheritance
    if {[llength $args] > 0} \
    { foreach {x y health} $args break } \
    else \
    {
      set x [expr {round($(xmax) * rand())}]
      set y [expr {round($(ymax) * rand())}]
      set health 0
    }
    # bug entity
    set ($bug:x) $x
    set ($bug:y) $y
    set ($bug:health) $health
    # display it
    .c create rectangle $x $y $x $y -tags b:$bug -width 2 -outline navy
    .c raise b:$bug
  }
  proc bug:death {bug} \
  {
    variable {}
    # remove the bug from its population
    set n [lsearch -exact $(bugs) $bug]
    if {$n > -1} \
    { set (bugs) [lreplace $(bugs) $n $n] }
    # free its resources
    array unset {} $bug:*
    # remove the bug from the box
    .c delete b:$bug
  }
  proc bug:clone {bug} \
  {
    variable {}
    set health [expr {$($bug:health) / 2}]
    # the clone
    bug:birth $($bug:x) $($bug:y) $health
    # the price to pay
    set ($bug:health) $health
  }
  proc bug:move {bug} \
  {
    variable {}
    # new position
    foreach c {x y} \
    {
      set v $($bug:$c)
      set old$c $v
      incr v [expr {round($(speed) * rand()) * (rand() > 0.5 ? +1 : -1)}]
      if {$v < 0} { set v 0}
      set max $(${c}max)
      if {$v > $max} { set v $max }
      set new$c $v
      set ($bug:$c) $v
    }
    # the price to pay
    incr ($bug:health) [expr {-int(sqrt(abs($newx - $oldx) + abs($newy - $oldy)))}]
    # the (eventual) fortune
    set x1 $oldx; set x2 $newx
    if {$x1 > $x2} { foreach {x1 x2} [list $x2 $x1] break }
    set y1 $oldy; set y2 $newy
    if {$y1 > $y2} { foreach {y1 y2} [list $y2 $y1] break }
    for {set x $x1} {$x <= $x2} {incr x} \
    {
      for {set y $y1} {$y <= $y2} {incr y} \
      { if {[info exists (food:$x:$y)]} { bug:lunch $bug $x $y } }
    }
    # the (eventual) misfortune
    if {$($bug:health) < 2 * -$(food)} \
    { bug:death $bug } \
    else \
    { .c coords b:$bug $newx $newy $newx $newy }
    update
  }
  proc bug:lunch {bug x y} \
  { 
    variable {}
    # get the food
    incr ($bug:health) $(food:$x:$y)
    # remove it from the box
    food:death $x $y
    # the (eventual) new life
    if {$($bug:health) > $(clone)} { bug:clone $bug }
  }
======

----

'''The Life loop'''

======
  # -----------
  # The Life
  # -----------

  # parms
  array set {} \
  {
    bugID   0
    #       {bugs population}
    bugs    {}
    #       {box width}
    xmax    200
    #       {box height}
    ymax    200
    #       {food nutritional value}
    food    20
    #       {bug speed}
    speed   2
    #       {health level before cloning}
    clone   40
    #       {food density}
    density 25
    #       {initial bugs count}
    initial 10
    #       {life step delay}
    delay   100
  }
  # create box
  wm title . Bugs
  wm protocol . WM_DELETE_WINDOW exit
  canvas .c -width $(xmax) -height $(ymax)
  pack .c
  # create foods
  set d [expr {$(density) / 2}]
  set n [expr {$d + round($d * rand())}]
  set n [expr {$d * ($d + round($d * rand()))}]
  for {} {$n > 0} {incr n -1} food:birth
  # create bugs
  for {set n $(initial)} {$n > 0} {incr n -1} bug:birth
  # the life loop
  while 1 \
  {
    set n [expr {$d + round($d * rand())}]
    for {} {$n > 0} {incr n -1} food:birth
    foreach bug $(bugs) { bug:move $bug}
    after $(delay)
  }
======


----

'''See also'''

   * [TkBugs]


<<categories>> Example | Toys | GUI