Version 17 of Elevator simulation

Updated 2007-06-25 19:06:06 by LV

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.

WikiDbImage 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 . <Escape> {exec wish $argv0 &; exit}
 bind . <F1> {console show}
 bind . <F2> {
    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 }