Arjen Markus (7 october 2004) David Cobac raised a question on the French Tcler's Wiki about helping kids to become programmers [L1 ]. 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:
If the script is extended with a few things:
And lots of other things!
AM (11 october 2004) Added a third example: traffic lights
Zarutian 14. april 2005: Hmm... NetLogo[L2 ] 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
}