Arjen Markus (19 january 2011) My first steps with TclOO involve simulating a flock of birds ... well, that is how the idea started: I watched several flocks of geese pass overhead in the characteristic V-shape and thought that this flying pattern might make a nice little toy application. The implementation below is only a shadow of such an application as the objects simply follow the leader, whereas in a flock the leading bird sometimes let itself fall behind and another take the lead. Not to mention the joining and forking that also occurs. But such dynamics asked too much of the limited time I had set myself.
This is also the reason for the ugly copying of a piece of code - the initial positioning of a new object wrt the one it will follow.
Anyway, have a look at this single file of objects.
# movingobjects.tcl --
# Simple experiment with TclOO:
# Objects moving in a canvas relative to each other
#
pack [canvas .c -width 400 -height 400]
# Auxiliary procedures
#
proc position {time} {
set xpos [expr {cos($time) - cos(sqrt(2.0)*$time)}]
set ypos [expr {sin($time) - sin(sqrt(2.0)*$time)}]
set time [expr {$time + 0.001}]
set xposn [expr {cos($time) - cos(sqrt(2.0)*$time)}]
set yposn [expr {sin($time) - sin(sqrt(2.0)*$time)}]
set dx [expr {$xposn-$xpos}]
set dy [expr {$yposn-$ypos}]
set dir [expr {atan2($dy,$dx)}]
return [list $xpos $ypos $dir]
}
#
# Create the class
#
oo::class create mbody {
variable isLeading
variable xpos
variable ypos
variable dir
variable time
variable cnvobj
variable leader
constructor {leading} {
variable time
variable xpos
variable ypos
variable dir
variable lead
variable leader
variable cnvobj
set time 0.0
set xpos 0.0
set ypos 0.0
set dir 0.0
set leader {}
if { $leading } {
set cnvobj [.c create oval 4 4 -4 -4 -fill red]
.c move $cnvobj 200 200
set lead 1
my move
} else {
set cnvobj [.c create oval 4 4 -4 -4 -fill blue]
set lead 0
.c move $cnvobj 200 200
my follow
}
}
method move {} {
variable time
variable xpos
variable ypos
variable dir
variable cnvobj
variable lead
variable leader
set xposo $xpos
set yposo $ypos
lassign [position $time] xpos ypos dir
.c move $cnvobj [expr {($xpos-$xposo) * 80}] [expr {($ypos-$yposo) * 80}]
set time [expr {$time + 0.03}]
after 100 [list [self] move]
}
method follows {object} {
variable leader
variable xpos
variable ypos
variable cnvobj
set leader $object
lassign [$leader position] xposf yposf dirf
set xoff [expr {-0.1*cos($dirf)}]
set yoff [expr {0.1*sin($dirf)}]
set dx [expr {($xposf + $xoff - $xpos)}]
set dy [expr {($yposf + $yoff - $ypos)}]
set xpos [expr {$xpos + $dx}]
set ypos [expr {$ypos + $dy}]
set dir [expr {atan2($dy,$dx)}]
.c move $cnvobj [expr {$dx * 80}] [expr {$dy * 80}]
}
method position {} {
variable xpos
variable ypos
variable dir
return [list $xpos $ypos $dir]
}
method follow {} {
variable time
variable xpos
variable ypos
variable dir
variable cnvobj
variable lead
variable leader
if { $leader != {} } {
lassign [$leader position] xposf yposf dirf
set xoff [expr {-0.1*cos($dirf)}]
set yoff [expr {0.1*sin($dirf)}]
set dx [expr {0.2 * ($xposf + $xoff - $xpos)}]
set dy [expr {0.2 * ($yposf + $yoff - $ypos)}]
set xpos [expr {$xpos + $dx}]
set ypos [expr {$ypos + $dy}]
set dir [expr {atan2($dy,$dx)}]
.c move $cnvobj [expr {$dx * 80}] [expr {$dy * 80}]
set time [expr {$time + 0.03}]
}
after 100 [list [self] follow]
}
}
#
# Now create a leading object and a buch that will follow it
# and each other. The Tk event loop does the rest.
#
set mainobj [mbody new 1]
set leader $mainobj
for { set i 0 } { $i < 10 } { incr i } {
set follower [mbody new 0]
$follower follows $leader
set leader $follower
}