TclTrain
if 0 {Richard Suchenwirth 2003-10-18 - This weekend fun project is again about model railroading with Tcl, now from the engineer's perspective. The train runs over an endless straight line (curves seeming too difficult for the moment), and what interested me was animation (let objects move somehow life-like) by canvas scaling (remember the cars in trains3.tcl?) I find it most exciting to pass under a bridge, or by a house. Even though the graphics are crude, it is sort of fun to watch.
The throttle is emulated by the cursor Up/Down keys, current speed is displayed at top left. (As objects are created by timer, you'll get more of them if you go slower - on my home computer, the following settings with speed 50 is barely manageable.) }
package require Tk
namespace eval tt {
variable version 0.1
variable deltaT 20
variable speed
}if 0 {The UI is a boring landscape, with the ballast and the rails at constant positions:}
proc tt::ui {w} {
variable canvas $w speed
$w create text -160 -50 -anchor nw -font {Helvetica 18} \
-tag {rail speed}
trace add variable tt::speed write "$w itemconfig speed -text \$tt::speed ;#"
set speed 50
$w create rect -200 0 200 250 -fill green4 ;# landscape
$w config -scrollregion {-200 -50 200 100}
#-- ballast and rails:
$w create poly -140 250 140 250 1 0 -1 0 -fill coral4 ;# ballast
$w create poly -100 250 -90 250 0 0 -fill white -outline white -tag rail
$w create poly 90 250 100 250 0 0 -fill white -outline white -tag rail
}if 0 {The illusion is that the train is moving through the landscape. In reality, the objects which make the landscape a bit interesting appear to move (especially the crossties which should be "seeded" at short intervals, but bring my 200MHz CPU at home down to its knees), by scaling them relative to the perspective point {0 0}. Objects are described by one or more canvas items, and tied together with a common tag:}
proc tt::bridge {} {
movable {
{poly {-100 160 -80 120 -80 -30 80 -30 80 120 100 160 100 -60
-100 -60} -fill gray40}
{poly {-2000 0 -60 -100 60 -100 2000 0 100 160 100 -50
-100 -50 -100 160} -fill gray60}
}
}
proc tt::bush1 {} {movable {{oval 400 200 480 250 -fill darkgreen}}}
proc tt::bush2 {} {movable {{oval -460 200 -490 300 -fill darkgreen}}}
proc tt::crosstie {} {
movable {{poly -105 200 -110 210 110 210 105 200 -fill burlywood4}}
}
proc tt::field {} {
set color [lpick {yellow green3 brown bisque black}]
movable "{poly 170 250 50 50 10000 50 10000 250 -fill $color}"
}
proc tt::milestone {} {
movable {{rect 140 180 150 210 -fill white -outline {}}}
}
proc tt::pond {} {movable {{oval -2000 100 -200 300 -fill lightblue}}}
proc tt::house {} {movable {
{poly 200 200 200 -200 400 -400 600 -200 600 200 -fill white}
{poly 200 200 120 100 120 -230 200 -200 -fill bisque}
{poly 190 -200 100 -230 250 -350 400 -400 -fill brown}
{rect 250 -160 350 -80 -fill lightblue -outline {}}
{rect 450 -160 550 -80 -fill lightblue -outline {}}
{rect 250 30 350 130 -fill lightblue -outline {}}
{rect 450 30 550 130 -fill lightblue -outline {}}
}}
proc tt::road {} {
movable {
{rect -20000 45 20000 75 -fill gray -outline gray}
{rect -20000 59 20000 61 -fill yellow -outline {}}
}
}
proc tt::signal {} {
movable {
{rect 150 -50 160 200 -fill black}
{rect 150 -50 200 -40 -fill red}
}
}if 0 {This generic "constructor" draws an object on the canvas, "moves" it to a far distance, and then starts the animation that lets it come closer to the observer:}
proc tt::movable items {
variable speed
if !$speed return
variable canvas; set w $canvas
set initialscale 0.02
set id [eval $w create [lindex $items 0]]
set tag t$id
$w itemconfig $id -tag "$tag mv"
foreach i [lrange $items 1 end] {eval $w create $i -tag "{$tag mv}"}
$w scale $tag 0 0 $initialscale $initialscale
$w lower $tag mv ;# behind previous objects
$w raise rail ;# so they're not covered by the road
animate $tag
}if 0 {The animation code first checks if the object has already passed the observer - then it is just deleted. Otherwise it is scaled depending on the current "speed", so that it appears to move closer and get bigger: }
proc tt::animate tag {
variable canvas; set w $canvas
variable deltaT; variable speed
foreach {x0 y0 x1 y1} [$w bbox $tag] break
if {$y0 > 250 || $y1 > 500} {
$w delete $tag
return
} elseif $speed {
set scale [expr {1.0 + $speed/2000. + $y1/3000.}] ;# (1)
$w scale $tag 0 0 $scale $scale
}
after $deltaT [list tt::animate $tag]
}#-- Some utilities of general use:
proc every {ms body} {eval $body; after $ms [info level 0]}
proc lpick list {lindex $list [expr int(rand()*[llength $list])]}#-- and off we go:
pack [canvas .c -bg lightblue]
tt::ui .c
every 100 tt::crosstie
every 20000 tt::milestone
every 5000 {eval [lpick {
tt::signal tt::road tt::bush1 tt::bush2 tt::bridge tt::pond
tt::house tt::field tt::field
}]}
bind . <Up> {incr tt::speed 1}
bind . <Down> {if {$tt::speed>0} {incr tt::speed -1}}
bind . <Escape> {exec wish $argv0 &; exit}if 0 {LES says: the objects approach fast when they are far and slowly when they're nearer, and I think it should be the opposite.
RS: Hmm.. the scaling factor depends only on speed (see line (1) above), so at a speed of 100 every object will be scaled 1.05, i.e. 5% bigger (and farther from center). Looking at the cross-ties, which are the moving objects most close together, their distances appear sufficiently natural to me... But of course, I put such pages on the Wiki to solicit comments, and improvement :) What do others think?
LES adds: I don't know about the code. It's out of my depth. All I'm saying is that the effect is not correct. The objects approach fast when they're far and seem to slow down. That would make you feel like you're braking every time an object goes by, if it weren't for the steady pace of the movement of the rail track, which catches a lot of the viewer's attention. Try this: close one of your eyes and flip two or three fingers before the animation so as to cover the track and perceive no more than the movement of the objects in the landscape. Every time something goes by, it feels like you're braking.
US Change the line
set scale [expr {1.0 + $speed/2000.}] ;# (1)
in procedure tt::animate to
set scale [expr {1.0 + $speed/2000. + $y1/3000.}] ;# (1)
Then it looks more realistic, doesn't it? - RS: Indeed - thanks Ulrich! Fixed above.
escargo 21 Oct 2003 - I put if 0 { around the sample lines above since the application would not run after using wish-reaper to pull down the code if they were left unmodified. - LES 29 Oct: Better to if-0 all of these post-code comments. Just did it. escargo - I am sure you meant well, but you don't understand why I did what I did and the effect of your undoing it. wish-reaper only pays attention to the indented code, not to the normal running text. Therefore, the use of if 0 { that is not part of indented code has no effect on the operation of the code reapers. So, what I fixed, you have unintentionally broken. LES - Ouch. I'm really sorry. escargo - Somebody removed the indentation, so now the lines are ignored when reaping, so all is good again.
I also noticed that when the simulation starts, the track has no ties at the beginning. The ties eventually appear, but only after a while. - RS: Right - all objects start in the perspective point, and then move forward. One could cover it up with a flash screen or such, but hey - this is just a little demo...
HJG Added check for "down-key" to avoid going to reverse gear.
}
Category Graphics | Category Animation | Category Toys | Arts and crafts of Tcl-Tk programming