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
