Moving objects - first steps with TclOO

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 xpos ypos dir time cnvobj leader lead

    constructor {leading} {
        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 {} {
        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} {
        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 {} {
        return [list $xpos $ypos $dir]
    }

    method follow {} {
        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 bunch 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
}

Screenshot Section

gold 10/08/2020. Added pix. cosmetics, and appendix below, but original source code above was unchanged. After watching the birds too long, believe that deck could be converted to interesting alphanumeric fonts on canvas. A screen pause button or bird shot might be useful here.