if 0 {[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. [http://mini.net/files/elevator.gif] We have the elevator car and a counterweight, connected by a strong wire that runs over a wheel on top of the building. (The wheel is turned by a motor, which is not shown). If you click a "diamond" button on a floor, the elevator comes there. When doors are open, you can click which floor you want to go to. (All in all, this project came out more complex than I eventually expected - but still it was worth the while :). ---- } 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 #-- for the scale to actually work correctly 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 {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.} namespace eval elevator {variable moving 0} if 0 {The "constructor" creates the car, the counterweight, the wheel and the wires:} proc elevator::create {w x y topy floors} { variable car; variable weight variable leftwire; variable rightwire 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::moveto $w $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::moveto %W $floor 1] } proc elevator::moveto {w floor {push 0}} { variable car; variable doors; variable weight variable leftwire; variable rightwire variable button; variable current variable moving if {[info exists current] && $current eq $floor} return if $push { if $moving return set moving 1 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}] 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 set moving 0 } } proc elevator::openDoors {w floor} { variable doors foreach {left right} $doors(ids,$floor) break while 1 { set coords [$w coords $left] set x [lindex $coords 2] if {$x<[lindex $coords 0]+4} break $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]] after 5 update idletasks } after 100 set doors(open) $floor bell } proc elevator::closeDoors w { variable doors if ![info exists doors(open)] return foreach {left right} $doors(ids,$doors(open)) break while 1 { set lcoords [$w coords $left] set lx [lindex $lcoords 2] set rcoords [$w coords $right] set rx [lindex $rcoords 0] if {$lx-2>=$rx} break $w coords $left [lreplace $lcoords 2 2 [+ $lx 1]] $w coords $right [lreplace $rcoords 0 0 [- $rx 1]] after 5 update idletasks } after 100 } #-- 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 . {exec wish $argv0 &; exit} bind . {console show} bind . { package require Img [image create photo -data .c] write elevator.gif } ---- if 0 { 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 seperate floors can not both press the up/down buttons at the same time on seperate 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 Programming'' [HJG] 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". ---- [Category Toys] - [Category Animation] - [Arts and crafts of Tcl-Tk programming] }