floor.tcl

genesis 2000 v9.1软件下载

# floor.tcl --
#
# This demonstration script creates a canvas widet that displays the
# floorplan for DEC's Western Research Laboratory.
#
# RCS: @(#) $Id: floor.tcl,v 1.2 1998/09/14 18:23:28 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# floorDisplay --
# Recreate the floorplan display in the canvas given by "w".  The
# floor given by "active" is displayed on top with its office structure
# visible.
#
# Arguments:
# w -		Name of the canvas window.
# active -	Number of active floor (1, 2, or 3).

proc floorDisplay {w active} {
    global floorLabels floorItems colors activeFloor

    if {$activeFloor == $active} {
	return
    }

    $w delete all
    set activeFloor $active

    # First go through the three floors, displaying the backgrounds for
    # each floor.

    bg1 $w $colors(bg1) $colors(outline1)
    bg2 $w $colors(bg2) $colors(outline2)
    bg3 $w $colors(bg3) $colors(outline3)

    # Raise the background for the active floor so that it's on top.

    $w raise floor$active

    # Create a dummy item just to mark this point in the display list,
    # so we can insert highlights here.

    $w create rect 0 100 1 101 -fill {} -outline {} -tags marker

    # Add the walls and labels for the active floor, along with
    # transparent polygons that define the rooms on the floor.
    # Make sure that the room polygons are on top.

    catch {unset floorLabels}
    catch {unset floorItems}
    fg$active $w $colors(offices)
    $w raise room

    # Offset the floors diagonally from each other.

    $w move floor1 2c 2c
    $w move floor2 1c 1c

    # Create items for the room entry and its label.

    $w create window 600 100 -anchor w -window $w.entry
    $w create text 600 100 -anchor e -text "Room: "
    $w config -scrollregion [$w bbox all]
}

# newRoom --
# This procedure is invoked whenever the mouse enters a room
# in the floorplan.  It changes tags so that the current room is
# highlighted.
#
# Arguments:
# w  -		The name of the canvas window.

proc newRoom w {
    global currentRoom floorLabels

    set id [$w find withtag current]
    if {$id != ""} {
	set currentRoom $floorLabels($id)
    }
    update idletasks
}

# roomChanged --
# This procedure is invoked whenever the currentRoom variable changes.
# It highlights the current room and unhighlights any previous room.
#
# Arguments:
# w -		The canvas window displaying the floorplan.
# args -	Not used.

proc roomChanged {w args} {
    global currentRoom floorItems colors
    $w delete highlight
    if [catch {set item $floorItems($currentRoom)}] {
	return
    }
    set new [eval \
	"$w create polygon [$w coords $item] -fill $colors(active) \
	-tags highlight"]
    $w raise $new marker
}

# bg1 --
# This procedure represents part of the floorplan database.  When
# invoked, it instantiates the background information for the first
# floor.
#
# Arguments:
# w -		The canvas window.
# fill -	Fill color to use for the floor's background.
# outline -	Color to use for the floor's outline.

proc bg1 {w fill outline} {
    $w create poly 347 80 349 82 351 84 353 85 363 92 375 99 386 104 \
	386 129 398 129 398 162 484 162 484 129 559 129 559 133 725 \
	133 725 129 802 129 802 389 644 389 644 391 559 391 559 327 \
	508 327 508 311 484 311 484 278 395 278 395 288 400 288 404 \
	288 409 290 413 292 418 297 421 302 422 309 421 318 417 325 \
	411 330 405 332 397 333 344 333 340 334 336 336 335 338 332 \
	342 331 347 332 351 334 354 336 357 341 359 340 360 335 363 \
	331 365 326 366 304 366 304 355 258 355 258 387 60 387 60 391 \
	0 391 0 337 3 337 3 114 8 114 8 25 30 25 30 5 93 5 98 5 104 7 \
	110 10 116 16 119 20 122 28 123 32 123 68 220 68 220 34 221 \
	22 223 17 227 13 231 8 236 4 242 2 246 0 260 0 283 1 300 5 \
	321 14 335 22 348 25 365 29 363 39 358 48 352 56 337 70 \
	344 76 347 80 \
	-tags {floor1 bg} -fill $fill
    $w create line 386 129 398 129 -fill $outline -tags {floor1 bg}
    $w create line 258 355 258 387 -fill $outline -tags {floor1 bg}
    $w create line 60 387 60 391 -fill $outline -tags {floor1 bg}
    $w create line 0 337 0 391 -fill $outline -tags {floor1 bg}
    $w create line 60 391 0 391 -fill $outline -tags {floor1 bg}
    $w create line 3 114 3 337 -fill $outline -tags {floor1 bg}
    $w create line 258 387 60 387 -fill $outline -tags {floor1 bg}
    $w create line 484 162 398 162 -fill $outline -tags {floor1 bg}
    $w create line 398 162 398 129 -fill $outline -tags {floor1 bg}
    $w create line 484 278 484 311 -fill $outline -tags {floor1 bg}
    $w create line 484 311 508 311 -fill $outline -tags {floor1 bg}
    $w create line 508 327 508 311 -fill $outline -tags {floor1 bg}
    $w create line 559 327 508 327 -fill $outline -tags {floor1 bg}
    $w create line 644 391 559 391 -fill $outline -tags {floor1 bg}
    $w create line 644 389 644 391 -fill $outline -tags {floor1 bg}
    $w create line 559 129 484 129 -fill $outline -tags {floor1 bg}
    $w create line 484 162 484 129 -fill $outline -tags {floor1 bg}
    $w create line 725 133 559 133 -fill $outline -tags {floor1 bg}
    $w create line 559 129 559 133 -fill $outline -tags {floor1 bg}
    $w create line 725 129 802 129 -fill $outline -tags {floor1 bg}
    $w create line 802 389 802 129 -fill $outline -tags {floor1 bg}
    $w create line 3 337 0 337 -fill $outline -tags {floor1 bg}
    $w create line 559 391 559 327 -fill $outline -tags {floor1 bg}
    $w create line 802 389 644 389 -fill $outline -tags {floor1 bg}
    $w create line 725 133 725 129 -fill $outline -tags {floor1 bg}
    $w create line 8 25 8 114 -fill $outline -tags {floor1 bg}
    $w create line 8 114 3 114 -fill $outline -tags {floor1 bg}
    $w create line 30 25 8 25 -fill $outline -tags {floor1 bg}
    $w create line 484 278 395 278 -fill $outline -tags {floor1 bg}
    $w create line 30 25 30 5 -fill $outline -tags {floor1 bg}
    $w create line 93 5 30 5 -fill $outline -tags {floor1 bg}
    $w create line 98 5 93 5 -fill $outline -tags {floor1 bg}
    $w create line 104 7 98 5 -fill $outline -tags {floor1 bg}
    $w create line 110 10 104 7 -fill $outline -tags {floor1 bg}
    $w create line 116 16 110 10 -fill $outline -tags {floor1 bg}
    $w create line 119 20 116 16 -fill $outline -tags {floor1 bg}
    $w create line 122 28 119 20 -fill $outline -tags {floor1 bg}
    $w create line 123 32 122 28 -fill $outline -tags {floor1 bg}
    $w create line 123 68 123 32 -fill $outline -tags {floor1 bg}
    $w create line 220 68 123 68 -fill $outline -tags {floor1 bg}
    $w create line 386 129 386 104 -fill $outline -tags {floor1 bg}
    $w create line 386 104 375 99 -fill $outline -tags {floor1 bg}
    $w create line 375 99 363 92 -fill $outline -tags {floor1 bg}
    $w create line 353 85 363 92 -fill $outline -tags {floor1 bg}
    $w create line 220 68 220 34 -fill $outline -tags {floor1 bg}
    $w create line 337 70 352 56 -fill $outline -tags {floor1 bg}
    $w create line 352 56 358 48 -fill $outline -tags {floor1 bg}
    $w create line 358 48 363 39 -fill $outline -tags {floor1 bg}
    $w create line 363 39 365 29 -fill $outline -tags {floor1 bg}
    $w create line 365 29 348 25 -fill $outline -tags {floor1 bg}
    $w create line 348 25 335 22 -fill $outline -tags {floor1 bg}
    $w create line 335 22 321 14 -fill $outline -tags {floor1 bg}
    $w create line 321 14 300 5 -fill $outline -tags {floor1 bg}
    $w create line 300 5 283 1 -fill $outline -tags {floor1 bg}
    $w create line 283 1 260 0 -fill $outline -tags {floor1 bg}
    $w create line 260 0 246 0 -fill $outline -tags {floor1 bg}
    $w create line 246 0 242 2 -fill $outline -tags {floor1 bg}
    $w create line 242 2 236 4 -fill $outline -tags {floor1 bg}
    $w create line 236 4 231 8 -fill $outline -tags {floor1 bg}
    $w create line 231 8 227 13 -fill $outline -tags {floor1 bg}
    $w create line 223 17 227 13 -fill $outline -tags {floor1 bg}
    $w create line 221 22 223 17 -fill $outline -tags {floor1 bg}
    $w create line 220 34 221 22 -fill $outline -tags {floor1 bg}
    $w create line 340 360 335 363 -fill $outline -tags {floor1 bg}
    $w create line 335 363 331 365 -fill $outline -tags {floor1 bg}
    $w create line 331 365 326 366 -fill $outline -tags {floor1 bg}
    $w create line 326 366 304 366 -fill $outline -tags {floor1 bg}
    $w create line 304 355 304 366 -fill $outline -tags {floor1 bg}
    $w create line 395 288 400 288 -fill $outline -tags {floor1 bg}
    $w create line 404 288 400 288 -fill $outline -tags {floor1 bg}
    $w create line 409 290 404 288 -fill $outline -tags {floor1 bg}
    $w create line 413 292 409 290 -fill $outline -tags {floor1 bg}
    $w create line 418 297 413 292 -fill $outline -tags {floor1 bg}
    $w create line 421 302 418 297 -fill $outline -tags {floor1 bg}
    $w create line 422 309 421 302 -fill $outline -tags {floor1 bg}
    $w create line 421 318 422 309 -fill $outline -tags {floor1 bg}
    $w create line 421 318 417 325 -fill $outline -tags {floor1 bg}
    $w create line 417 325 411 330 -fill $outline -tags {floor1 bg}
    $w create line 411 330 405 332 -fill $outline -tags {floor1 bg}
    $w create line 405 332 397 333 -fill $outline -tags {floor1 bg}
    $w create line 397 333 344 333 -fill $outline -tags {floor1 bg}
    $w create line 344 333 340 334 -fill $outline -tags {floor1 bg}
    $w create line 340 334 336 336 -fill $outline -tags {floor1 bg}
    $w create line 336 336 335 338 -fill $outline -tags {floor1 bg}
    $w create line 335 338 332 342 -fill $outline -tags {floor1 bg}
    $w create line 331 347 332 342 -fill $outline -tags {floor1 bg}
    $w create line 332 351 331 347 -fill $outline -tags {floor1 bg}
    $w create line 334 354 332 351 -fill $outline -tags {floor1 bg}
    $w create line 336 357 334 354 -fill $outline -tags {floor1 bg}
    $w create line 341 359 336 357 -fill $outline -tags {floor1 bg}
    $w create line 341 359 340 360 -fill $outline -tags {floor1 bg}
    $w create line 395 288 395 278 -fill $outline -tags {floor1 bg}
    $w create line 304 355 258 355 -fill $outline -tags {floor1 bg}
    $w create line 347 80 344 76 -fill $outline -tags {floor1 bg}
    $w create line 344 76 337 70 -fill $outline -tags {floor1 bg}