Updated 2012-05-13 17:28:22 by RLE

Arjen Markus (7 october 2004) David Cobac raised a question on the French Tcler's Wiki about helping kids to become programmers [1]. I have wondered myself about it from time to time and I recently became interested in "agents" as more or less independent program "entities" that live in some "world" and interact with each other. This inspired me to try something in that direction...

The paradigm of an agent seems very adequate to me: it allows you to define a small world in which "beings" run around and do things

Note: the script below is far from complete - the user-interface is rather non-existant, apart from a tree control that only shows you the variables. If at all useful, it should offer an integrated environment for developing this type of programs.

I took the word "sprite" from LOGO.

So, here is a first version!

Oh, should you want some exercises:

  • Make the eyes follow the purple dog by combining the two examples
  • Make a polka dot that follows the cursor and changes colour from time to time
  • Make the rabbits hunt the dog
  • Emulate the classic game of "pong"
  • Emulate the classic game of "pacman"

If the script is extended with a few things:

  • Emulate turtle graphics (including drawing trees)
  • A simple drawing program

And lots of other things!

AM (11 october 2004) Added a third example: traffic lights
Zarutian 14. april 2005: Hmm... NetLogo[2] is probably similar what you are thinking about.
 # arena.tcl --
 #    Run a small arena with various agents (animals if you like) that
 #    hunt or hinder each other
 #    Use:
 #       wish arena.tcl agents.def
 #    (agents.def defines what agents)
 #
 #    Problems:
 #    - Errors in the user-defined script can make the application
 #      enter an endless loop of error messages. (catch these in
 #      the "act" procedure?)
 #    - No checking of unique names yet - may lead to error messages
 #    - If you write to the (Windows) console in an action callback, the
 #      application may get stuck.
 #
 package require Tk
 package require BWidget

 #
 # Create the main window
 #
 proc MainWindow {_width _height} {
    global canvas
    global ctree
    global width
    global height

    set width  $_width
    set height $_height

    set canvas [canvas .cnv -width $width -height $height -background white]
    set ctree  [Tree   .ctree]

    grid $ctree $canvas -sticky news
 }

 #
 # Basic shapes
 #
 proc oval {color xmin ymin xmax ymax} {
    global canvas

    $canvas create oval $xmin $ymin $xmax $ymax -fill $color
 }

 proc rectangle {color xmin ymin xmax ymax} {
     global canvas

     $canvas create rectangle $xmin $ymin $xmax $ymax -fill $color
 }

 #
 # Agents
 #
 proc type-agent {type data} {
     global ctree
     global agent_type

     set agent_type($type) $data

     $ctree insert end root type_$type -text $type
 }

 proc agent {type name data} {
     global agent_type
     global agent
     global ctree

     set agent($name,type) $type

     $ctree insert end type_$type agent_$name -text $name

     ConstructAgent $name initial color black
     ConstructAgent $name initial form  dot
     ConstructAgent $name initial size  10
     set agent($name,oldattr,position)     {0 0}
     ConstructAgent $name initial position {0 0}

     set cmd {}
     foreach line [split $agent_type($type) \n] {
         if { [string trim $line] == "" } {
            continue
         }
         append cmd $line
         if { [info complete $cmd] } {
            eval ConstructAgent [list $name] $cmd
            set cmd {}
         } else {
            append cmd \n
         }
     }
     foreach {key value} $data {
         ConstructAgent $name change $key $value
     }
     DrawAgent $name 1
 }

 proc ConstructAgent {name command args} {
     global ctree
     global agent

     switch -- $command {
         "initial" {
             foreach {key value} $args break
             set agent($name,attr,$key) $value
             if { ! [$ctree exists agent_${name}_$key] } {
                 $ctree insert end agent_$name \
                                  agent_${name}_$key -text "$key = $value"
             } else {
                 $ctree itemconfigure \
                                  agent_${name}_$key -text "$key = $value"
             }
         }
         "change" {
             foreach {key value} $args break
             set agent($name,attr,$key) $value
             $ctree itemconfigure agent_${name}_$key -text "$key = $value"
         }
         "action" {
             foreach {key cmds} $args break
             set agent($name,cmds,$key) $cmds
         }
         "start" {
             act $name $args
         }
     }
 }

 proc DrawAgent {name create} {
     global canvas
     global agent

     #
     # For now: simply a dot
     #
     if { $create } {
         set agent($name,id) \
             [$canvas create oval 0 0 \
                  $agent($name,attr,size) $agent($name,attr,size) \
                  -fill $agent($name,attr,color)]
     }

     $canvas coords $agent($name,id) 0 0 \
                  $agent($name,attr,size) $agent($name,attr,size)

     foreach {dx dy} $agent($name,attr,position) {
         set dx [expr {$dx-0.5*$agent($name,attr,size)}]
         set dy [expr {$dy-0.5*$agent($name,attr,size)}]
         break
     }
     $canvas move $agent($name,id) $dx $dy

     $canvas itemconfigure $agent($name,id) -fill $agent($name,attr,color)
 }

 proc act {name action} {
     global self
     if { $name == "Self" } {
        set name $self
     }
     after 50 [list ActAgent $name $action]
 }

 proc ActAgent {name action} {
     global self
     global agent

     set self $name
     eval $agent($name,cmds,$action)
     DrawAgent $name 0
 }

 #
 # Things an agent can do
 #

 proc add {op1 op2} {
     expr {$op1+$op2}
 }

 proc mult {op1 op2} {
     expr {$op1*$op2}
 }

 proc random {op1} {
     expr {rand()*$op1}
 }

 proc direction {from to} {
     global self
     global agent
     #
     # For the moment: only positions
     #
     foreach {x1 y1} $from {break}
     foreach {x2 y2} $to   {break}

     expr {atan2(($y2-$y1),($x2-$x1))*180.0/3.1415926}
 }

 proc distance {from to} {
     global self
     global agent
     #
     # For the moment: only positions
     #
     foreach {x1 y1} $from {break}
     foreach {x2 y2} $to   {break}

     expr {hypot(($y2-$y1),($x2-$x1))}
 }

 proc delay {delay} {
    set ::continue 0
    after [expr {int(1000*$delay)}] {set ::continue 1}
    vwait ::continue
 }


 proc newpos {start dist dir} {
     global self
     global agent
     global width
     global height
     #
     # For the moment: only positions
     #
     foreach {xold yold} $start {break}
     set xnew [expr {$xold+$dist*cos($dir/180.0*3.1415926)}]
     set ynew [expr {$yold+$dist*sin($dir/180.0*3.1415926)}]

     if { $xnew < 0.0 } {
        set xnew [expr {$xnew+$width}]
     }
     if { $ynew < 0.0 } {
        set ynew [expr {$ynew+$height}]
     }
     if { $xnew > $width } {
        set xnew [expr {$xnew-$width}]
     }
     if { $ynew > $height } {
        set ynew [expr {$ynew-$height}]
     }
     list $xnew $ynew
 }

 proc change-attr {name attr value} {
     global self
     global agent
     if { $name == "Self" } {
        set name $self
     }
     if { $attr == "position" } {
        set agent($name,oldattr,$attr) $agent($name,attr,$attr)
     }
     ConstructAgent $name change $attr $value
     DrawAgent $name 0
 }
 proc get-attr {name attr} {
     global agent
     global self
     if { $name == "Self" } {
        set name $self
     }
     return $agent($name,attr,$attr)
 }

 #
 # Bring up the main window
 #
 MainWindow 300 300

 #
 # Define the mouse agent
 #
 type-agent Mouse {}
 agent Mouse Mouse {position {-100 -100}}
 bind $canvas <Motion> {ConstructAgent Mouse initial position {%x %y}}

 #
 # Test: xeyes-like agents
 #

 if { 0 } {
 oval black 100 100 160 180
 oval white 105 105 155 175
 oval black 200 100 260 180
 oval white 205 105 255 175

 type-agent Eye {
     initial color    green
     initial position {0 0}
     initial centre   {0 0}
     action where {
         set    centre   [get-attr Self centre]
         set    dir      [direction $centre [get-attr Mouse position]]
         set    pos      [newpos $centre 20 $dir]
         change-attr Self position $pos

         #
         # Change color and size if the mouse is very close
         # to the left (!) eye
         # Note:
         # You get somewhat unexpected effects if you do not
         # restrict this to one eye!
         #
         if { $name == "left" } {
             set dist [distance $pos [get-attr Mouse position]]
             if { $dist < 40 } {
                 change-attr left color blue
                 change-attr right size 30
             } else {
                 change-attr left color green
                 change-attr right size 10
             }
         }
         act Self where
     }
     start where ;# We need to kick the agent into action
 }

 set count 0
 agent Eye left  {position {145 140} centre {130 140}}
 agent Eye right {position {245 140} centre {230 140}}
 }

 if { 1 } {
 #
 # Test: dog hunting rabbits
 # Note:
 # Getting the distances right takes some experimenting.
 # With the settings that are given, the movements of the dog
 # are rather smooth. The rabbits "jitter" a bit.
 #

 type-agent Rabbit {
     initial color    brown
     initial position {0 0}
     action fleedog {
         set selfpos  [get-attr Self position]
         set dogpos   [get-attr dog position]
         if { [distance $selfpos $dogpos] < 50 } {
             set dir [direction $selfpos $dogpos]
             set rnd [random 360]
             set pos [newpos $selfpos 20 [add $dir $rnd]]
             change-attr Self position $pos
             change-attr Self color    yellow
         } else {
             change-attr Self color    brown
         }

         act Self fleedog
     }
     start fleedog ;# We need to kick the agent into action
 }

 type-agent Dog {
     initial color    magenta
     initial size     30
     initial position {0 0}
     action chaserabbit {
         set mindist   1000000000.0
         set dir       ""
         foreach r {rabbit1 rabbit2 rabbit3} {
             set selfpos   [get-attr Self position]
             set rabbitpos [get-attr $r   position]
             if { [distance $selfpos $rabbitpos] < $mindist } {
                 set mindist [distance  $selfpos $rabbitpos]
                 set dir     [direction $selfpos $rabbitpos]
             }
         }

         if { $dir != "" } {
             set pos [newpos $selfpos [mult $mindist 0.1] $dir]
             change-attr Self position $pos
         }

         act Self chaserabbit
     }
     start chaserabbit ;# We need to kick the agent into action
 }

 agent Rabbit rabbit1  {position {40 290}}
 agent Rabbit rabbit2  {position {140 90}}
 agent Rabbit rabbit3  {position {290 90}}
 agent Dog dog {position {245 140}}
 }

 #
 # Traffic lights
 #
 if { 0 } {
 rectangle black   70  70 130 250
 type-agent TrafficLight {
     initial color    darkgrey
     initial on-color purple
     initial position {0 0}
     initial size     40
     initial next     ?
     initial delay    1
     action changecolor {
         change-attr Self color [get-attr Self on-color]
         delay [get-attr Self delay]
         change-attr Self color darkgrey
         act [get-attr Self next] changecolor
     }
 }
 agent TrafficLight green  { position {100 220} on-color green  next orange}
 agent TrafficLight orange { position {100 160} on-color orange next red}
 agent TrafficLight red    { position {100 100} on-color red    next green}
 act green changecolor
 }