** Description ** 

[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 :).

** Code **

======
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 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
    }
}
======

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 **

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 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".

----

[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.

<<categories>> Toys | Animation | Arts and crafts of Tcl-Tk programming