[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
}

======
<<categories>>Category Toys|Category Object Orientation