# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# PURPOSE: Procedures for managing toasters in the usual
|
# PURPOSE: Procedures for managing toasters in the usual
|
# procedure-oriented Tcl programming style. These
|
# procedure-oriented Tcl programming style. These
|
# routines illustrate data sharing through global
|
# routines illustrate data sharing through global
|
# variables and naming conventions to logically group
|
# variables and naming conventions to logically group
|
# related procedures. The same programming task can
|
# related procedures. The same programming task can
|
# be accomplished much more cleanly with [incr Tcl].
|
# be accomplished much more cleanly with [incr Tcl].
|
# Inheritance also allows new behavior to be "mixed-in"
|
# Inheritance also allows new behavior to be "mixed-in"
|
# more cleanly (see Appliance and Product base classes).
|
# more cleanly (see Appliance and Product base classes).
|
#
|
#
|
# AUTHOR: Michael J. McLennan Phone: (610)712-2842
|
# AUTHOR: Michael J. McLennan Phone: (610)712-2842
|
# AT&T Bell Laboratories E-mail: michael.mclennan@att.com
|
# AT&T Bell Laboratories E-mail: michael.mclennan@att.com
|
#
|
#
|
# RCS: $Id: usualway.tcl,v 1.1.1.1 2002-01-16 10:24:47 markom Exp $
|
# RCS: $Id: usualway.tcl,v 1.1.1.1 2002-01-16 10:24:47 markom Exp $
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# Copyright (c) 1993 AT&T Bell Laboratories
|
# Copyright (c) 1993 AT&T Bell Laboratories
|
# ======================================================================
|
# ======================================================================
|
# Permission to use, copy, modify, and distribute this software and its
|
# Permission to use, copy, modify, and distribute this software and its
|
# documentation for any purpose and without fee is hereby granted,
|
# documentation for any purpose and without fee is hereby granted,
|
# provided that the above copyright notice appear in all copies and that
|
# provided that the above copyright notice appear in all copies and that
|
# both that the copyright notice and warranty disclaimer appear in
|
# both that the copyright notice and warranty disclaimer appear in
|
# supporting documentation, and that the names of AT&T Bell Laboratories
|
# supporting documentation, and that the names of AT&T Bell Laboratories
|
# any of their entities not be used in advertising or publicity
|
# any of their entities not be used in advertising or publicity
|
# pertaining to distribution of the software without specific, written
|
# pertaining to distribution of the software without specific, written
|
# prior permission.
|
# prior permission.
|
#
|
#
|
# AT&T disclaims all warranties with regard to this software, including
|
# AT&T disclaims all warranties with regard to this software, including
|
# all implied warranties of merchantability and fitness. In no event
|
# all implied warranties of merchantability and fitness. In no event
|
# shall AT&T be liable for any special, indirect or consequential
|
# shall AT&T be liable for any special, indirect or consequential
|
# damages or any damages whatsoever resulting from loss of use, data or
|
# damages or any damages whatsoever resulting from loss of use, data or
|
# profits, whether in an action of contract, negligence or other
|
# profits, whether in an action of contract, negligence or other
|
# tortuous action, arising out of or in connection with the use or
|
# tortuous action, arising out of or in connection with the use or
|
# performance of this software.
|
# performance of this software.
|
# ======================================================================
|
# ======================================================================
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# COMMAND: make_toaster <name> <heat>
|
# COMMAND: make_toaster <name> <heat>
|
#
|
#
|
# INPUTS
|
# INPUTS
|
# <name> = name of new toaster
|
# <name> = name of new toaster
|
# <heat> = heat setting (1-5)
|
# <heat> = heat setting (1-5)
|
#
|
#
|
# RETURNS
|
# RETURNS
|
# name of new toaster
|
# name of new toaster
|
#
|
#
|
# SIDE-EFFECTS
|
# SIDE-EFFECTS
|
# Creates a record of a new toaster with the given heat setting
|
# Creates a record of a new toaster with the given heat setting
|
# and an empty crumb tray.
|
# and an empty crumb tray.
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
proc make_toaster {name heat} {
|
proc make_toaster {name heat} {
|
global allToasters
|
global allToasters
|
|
|
if {$heat < 1 || $heat > 5} {
|
if {$heat < 1 || $heat > 5} {
|
error "invalid heat setting: should be 1-5"
|
error "invalid heat setting: should be 1-5"
|
}
|
}
|
set allToasters($name-heat) $heat
|
set allToasters($name-heat) $heat
|
set allToasters($name-crumbs) 0
|
set allToasters($name-crumbs) 0
|
}
|
}
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# COMMAND: toast_bread <name> <slices>
|
# COMMAND: toast_bread <name> <slices>
|
#
|
#
|
# INPUTS
|
# INPUTS
|
# <name> = name of toaster used to toast bread
|
# <name> = name of toaster used to toast bread
|
# <slices> = number of bread slices (1 or 2)
|
# <slices> = number of bread slices (1 or 2)
|
#
|
#
|
# RETURNS
|
# RETURNS
|
# current crumb count
|
# current crumb count
|
#
|
#
|
# SIDE-EFFECTS
|
# SIDE-EFFECTS
|
# Toasts bread and adds crumbs to crumb tray.
|
# Toasts bread and adds crumbs to crumb tray.
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
proc toast_bread {name slices} {
|
proc toast_bread {name slices} {
|
global allToasters
|
global allToasters
|
|
|
if {[info exists allToasters($name-crumbs)]} {
|
if {[info exists allToasters($name-crumbs)]} {
|
set c $allToasters($name-crumbs)
|
set c $allToasters($name-crumbs)
|
set c [expr $c+$allToasters($name-heat)*$slices]
|
set c [expr $c+$allToasters($name-heat)*$slices]
|
set allToasters($name-crumbs) $c
|
set allToasters($name-crumbs) $c
|
} else {
|
} else {
|
error "not a toaster: $name"
|
error "not a toaster: $name"
|
}
|
}
|
}
|
}
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# COMMAND: clean_toaster <name>
|
# COMMAND: clean_toaster <name>
|
#
|
#
|
# INPUTS
|
# INPUTS
|
# <name> = name of toaster to be cleaned
|
# <name> = name of toaster to be cleaned
|
#
|
#
|
# RETURNS
|
# RETURNS
|
# current crumb count
|
# current crumb count
|
#
|
#
|
# SIDE-EFFECTS
|
# SIDE-EFFECTS
|
# Cleans toaster by emptying crumb tray.
|
# Cleans toaster by emptying crumb tray.
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
proc clean_toaster {name} {
|
proc clean_toaster {name} {
|
global allToasters
|
global allToasters
|
set allToasters($name-crumbs) 0
|
set allToasters($name-crumbs) 0
|
}
|
}
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# COMMAND: destroy_toaster <name>
|
# COMMAND: destroy_toaster <name>
|
#
|
#
|
# INPUTS
|
# INPUTS
|
# <name> = name of toaster to be destroyed
|
# <name> = name of toaster to be destroyed
|
#
|
#
|
# RETURNS
|
# RETURNS
|
# nothing
|
# nothing
|
#
|
#
|
# SIDE-EFFECTS
|
# SIDE-EFFECTS
|
# Spills all crumbs in the toaster and then destroys it.
|
# Spills all crumbs in the toaster and then destroys it.
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
proc destroy_toaster {name} {
|
proc destroy_toaster {name} {
|
global allToasters
|
global allToasters
|
|
|
if {[info exists allToasters($name-crumbs)]} {
|
if {[info exists allToasters($name-crumbs)]} {
|
puts stdout "$allToasters($name-crumbs) crumbs ... what a mess!"
|
puts stdout "$allToasters($name-crumbs) crumbs ... what a mess!"
|
unset allToasters($name-heat)
|
unset allToasters($name-heat)
|
unset allToasters($name-crumbs)
|
unset allToasters($name-crumbs)
|
}
|
}
|
}
|
}
|
|
|
