Description edit
Richard Suchenwirth 2004-09-21: Tcl and Tk make programming almost everything very easy - so after less fascinating coding at work, I decided to do another fun project at home: an elevator model. This may also serve as educational toy for kids.Code edit
proc main {} {
pack [canvas .c -width 200 -height 460]
set floors {4 3 2 1}
elevator::create .c 100 450 150 $floors
.c create line 0 50 200 50 -width 5 -fill gray50
foreach y {150 250 350 450} floor $floors {
.c create line 0 $y 200 $y -width 5 -fill gray50
elevator::door .c 100 $y $floor
.c create text 90 [- $y 60] -text $floor
}
}n-floor variant by JH is just a starter - requires other code changes or the scale to actually work correctlypackage require Tk
proc main {{numFloors 4} {scale 100}} {
set halfscale [expr {$scale / 2}]
set width 200
set height [expr {$numFloors * $scale + $halfscale + 10}]
set w .c
destroy $w
pack [canvas $w -width $width -height $height] -fill both -expand 1
set floors {}
for {set i $numFloors} {$i > 0} {incr i -1} {
lappend floors $i
}
elevator::create $w [expr {$width/2}] \
[expr {$numFloors * $scale + $halfscale}] \
[expr {$scale + $halfscale}] $floors
$w create line 0 $halfscale $width $halfscale -width 5 -fill gray50
foreach floor $floors {
set y [expr {($numFloors - $floor + 1) * $scale + $halfscale}]
$w create line 0 $y $width $y -width 5 -fill gray50
elevator::door $w [expr {$width / 2}] $y $floor
$w create text [expr {$width / 2 - 10}] \
[expr {$y - $halfscale - 10}] -text $floor
}
}While coding, I noticed that the complexity grew, so I decided to place elevator-specific stuff in a namespace. This code is not exactly OO, but at least I tried to encapsulate some of the gorey details in that namespace.package require Tk
proc main {{numFloors 4} {scale 100}} {
set halfscale [expr {$scale / 2}]
set width 200
set height [expr {$numFloors * $scale + $halfscale + 10}]
set w .c
destroy $w
pack [canvas $w -width $width -height $height] -fill both -expand 1
set floors {}
for {set i $numFloors} {$i > 0} {incr i -1} {
lappend floors $i
}
elevator::create $w [expr {$width/2}] \
[expr {$numFloors * $scale + $halfscale}] \
[expr {$scale + $halfscale}] $floors
$w create line 0 $halfscale $width $halfscale -width 5 -fill gray50
foreach floor $floors {
set y [expr {($numFloors - $floor + 1) * $scale + $halfscale}]
$w create line 0 $y $width $y -width 5 -fill gray50
elevator::door $w [expr {$width / 2}] $y $floor
$w create text [expr {$width / 2 - 10}] \
[expr {$y - $halfscale - 10}] -text $floor
}
}
if 0 {The "constructor" creates the car, the counterweight, the wheel and the wires:}
namespace eval elevator {}
proc elevator::create {w x y topy floors} {
variable state
variable car; variable weight
variable leftwire; variable rightwire
variable busy {}
set item [$w create rect $x [+ $y 5] [+ $x 50] [- $y 70] -fill beige]
set car t$item
$w addtag $car withtag $item
$w create line [+ $x 5] [- $y 70] [+ $x 25] [- $y 90] \
[+ $x 45] [- $y 70] -tag $car -width 2
set bx [+ $x 25]
set by [- $y 58]
if {[llength $floors]>5} { ;# more than 5 buttons must be placed in 2 columns
set bx [- $bx 6]
set by [+ $by 7]
}
foreach floor $floors {
set f [$w create text $bx $by -text $floor -tag $car]
$w addtag t$f withtag $f
set bb [$w bbox $f]
$w create rect $bb -fill yellow -outline {} -tag [list $car t$f]
$w raise $f
$w bind t$f <1> [list elevator::behave $w moveto $floor 1]
incr by 13
if {$by>$y} { ;# 2nd button-column
set bx [+ $bx 15]
set by [- $y 51] ;# 58-7
}
}
$w create oval [+ $x 25] [- $topy 138] [+ $x 58] [- $topy 105] \
-fill OliveDrab3
set xm [+ $x 42]
set ym [- $topy 121]
$w create line [+ $x 25] $ym [+ $x 58] $ym -tag spoke
$w create line $xm [- $topy 138] $xm [- $topy 105] -tag spoke
set leftwire [$w create line [+ $x 25] $ym \
[+ $x 25] [- $y 90] -width 2]
set rightwire [$w create line [+ $x 59] $ym \
[+ $x 59] [- $topy 100] -width 2]
$w create line [+ $x 25] [- $topy 100] $xm $ym \
[+ $x 58] [- $topy 100] -fill OliveDrab4 -width 3
set weight [$w create rect [+ $x 55] $topy \
[+ $x 61] [- $topy 100] -fill brown]
}
proc elevator::door {w x y floor} {
variable doors
set doors(y,$floor) $y
$w create rect [+ $x 5] [- $y 2] [+ $x 45] [- $y 65] -fill {}
arrowbuttons $w [- $x 15] $y $floor
set xm [+ $x 25]
set l [$w create rect [+ $x 5] [- $y 2] $xm [- $y 65] -fill white]
set r [$w create rect $xm [- $y 2] [+ $x 45] [- $y 65] -fill white]
set doors(ids,$floor) [list $l $r]
}
proc elevator::arrowbuttons {w x y floor} {
$w create rect $x [- $y 32] [+ $x 10] [- $y 50] -fill white
set id [$w create poly [+ $x 1] [- $y 41] [+ $x 5] [- $y 48] \
[+ $x 9] [- $y 41] [+ $x 5] [- $y 34] \
-fill gray -outline black]
$w bind $id <1> [list elevator::behave %W moveto $floor 1]
}
proc elevator::moveto {w floor {push 0}} {
variable busy {}
variable car; variable doors; variable weight
variable leftwire; variable rightwire
variable button; variable current
if {[info exists current] && $current eq $floor} return
if $push {
set button [$w find withtag current]
if {[$w type $button] eq "polygon"} {
$w itemconfig $button -fill yellow
}
closeDoors $w
}
set currentY [lindex [$w bbox $car] 3]
set targetY [+ $doors(y,$floor) 5]
set dy [- $targetY $currentY]
if {$dy} {
set sdy [sgn $dy]
$w move $car 0 $sdy
$w move $weight 0 [- 0 $sdy]
set coords [$w coords $leftwire]
set topy [lindex $coords 3]
$w coords $leftwire [lreplace $coords 3 3 [+ $topy $sdy]]
set coords [$w coords $rightwire]
set topy [lindex $coords 3]
$w coords $rightwire [lreplace $coords 3 3 [- $topy $sdy]]
rotate $w spoke [expr {$sdy*-0.05}]
set busy [after 10 [list ::elevator::moveto $w $floor]]
} else {
if {[$w type $button] eq "polygon"} {
$w itemconfig $button -fill gray
}
openDoors $w $floor
set current $floor
}
}
proc elevator::openDoors {w floor} {
variable busy {}
variable doors
foreach {left right} $doors(ids,$floor) break
set coords [$w coords $left]
set x [lindex $coords 2]
if {$x<[lindex $coords 0]+4} {
after 100
set doors(open) $floor
bell
} else {
$w coords $left [lreplace $coords 2 2 [- $x 1]]
set coords [$w coords $right]
set x [lindex $coords 0]
$w coords $right [lreplace $coords 0 0 [+ $x 1]]
set busy [after idle after 5 [list [namespace current]::openDoors $w $floor]]
}
}
proc elevator::closeDoors w {
variable busy {}
variable doors
if ![info exists doors(open)] return
foreach {left right} $doors(ids,$doors(open)) break
set lcoords [$w coords $left]
set lx [lindex $lcoords 2]
set rcoords [$w coords $right]
set rx [lindex $rcoords 0]
if {$lx-2>=$rx} {
after 100
} else {
$w coords $left [lreplace $lcoords 2 2 [+ $lx 1]]
$w coords $right [lreplace $rcoords 0 0 [- $rx 1]]
set busy [after 5 after idle [list [namespace current]::closeDoors $w]]
}
}
proc elevator::behave {w behaviour args} {
variable busy
if {$busy ne {}} {
return
}
set busy [after idle [list [namespace current]::$behaviour $w {*}$args]]
}
#-- Arithmetic shortcuts
proc + {a b} {expr {$a+$b}}
proc - {a b} {expr {$a-$b}}
proc sgn x {expr {($x>0)-($x<0)}}
#-- Generally useful canvas routines
proc center {w id} {
set xsum 0.; set ysum 0; set n 0
foreach {x y} [$w coords $id] {
set xsum [+ $xsum $x]
set ysum [+ $ysum $y]
incr n
}
list [expr {$xsum/$n}] [expr {$ysum/$n}]
}
proc rotate {w tag angle} {
foreach item [$w find withtag $tag] {
set cs {}
foreach {xm ym} [center $w $item] break
foreach {x y} [$w coords $item] {
set r [expr {hypot($ym-$y,$xm-$x)}]
set a [expr {atan2($ym-$y,$xm-$x)+$angle}]
lappend cs [expr {$xm+cos($a)*$r}] [expr {$ym+sin($a)*$r}]
}
$w coords $item $cs
}
}
#-- Let's go!
#main1 ;# old
main 6 ;# ok: upto 8 floors, default: 4
#-- Dev helpers
bind . <Escape> {exec wish $argv0 &; exit}
bind . <F1> {console show}
bind . <F2> {
package require Img
[image create photo -data .c] write elevator.gif
}Discussion edit
FYI ... There is an elevator simulator that comes with a Java educational programming book by Dietel and Dietel, but in Java it's much more lines of code to program something like this, which is not necessarily a good thing. I also noticed when trying out the Tcl/Tk evelator sim (above) that persons waiting to ride on separate floors can not both press the up/down buttons at the same time on separate floors. A real elevator would queue passengers button presses and pick them up in the direction the elevator was traveling.HJG: To make this work, the commands .. bind .. [list elevator::moveto $w $floor 1] would have to be replaced with some mechanism to enqueue and schedule commands.KPV: Donald Knuth provides a lengthy description of an elevator simulation focusing on physical properties of the elevators including acceleration between floors and the time for doors to open and close. I think it's in volume 1 Fundamental Algorithms of The Art of Computer ProgrammingHJG: Added some more support to the n-floor variant: now upto 8 buttons inside the car are drawn more evenly spaced. Seven floors fit (barely) on my screen... As a more general solution, a detached panel for the buttons inside the car would be nice. That would have enough room for more level-buttons, as well extras like "open door", "emergency-stop", and "alarm".PYK 2016-09-26: A couple of years ago I eliminated update idletasks in this program, modifying the routines to iteratively reschedule themselves instead. I also added a command, behave, which is just a simple routine the elevator uses to decide whether it's already busy when user input arrives. This mechanism could be fleshed out to do more complicated things such as queuing up user requests.
