[Arjen Markus] (7 october 2004) David Cobac raised a question on the French Tcler's Wiki about helping kids to become programmers [http://wfr.tcl.tk/746]. 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[http://ccl.northwestern.edu/netlogo/] 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 {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 } ---- !!!!!! %|[Category Education]|% !!!!!!