1 |
578 |
markom |
# ----------------------------------------------------------------------
|
2 |
|
|
# PURPOSE: Procedures for managing toasters in the usual
|
3 |
|
|
# procedure-oriented Tcl programming style. These
|
4 |
|
|
# routines illustrate data sharing through global
|
5 |
|
|
# variables and naming conventions to logically group
|
6 |
|
|
# related procedures. The same programming task can
|
7 |
|
|
# be accomplished much more cleanly with [incr Tcl].
|
8 |
|
|
# Inheritance also allows new behavior to be "mixed-in"
|
9 |
|
|
# more cleanly (see Appliance and Product base classes).
|
10 |
|
|
#
|
11 |
|
|
# AUTHOR: Michael J. McLennan Phone: (610)712-2842
|
12 |
|
|
# AT&T Bell Laboratories E-mail: michael.mclennan@att.com
|
13 |
|
|
#
|
14 |
|
|
# RCS: $Id: usualway.tcl,v 1.1.1.1 2002-01-16 10:24:47 markom Exp $
|
15 |
|
|
# ----------------------------------------------------------------------
|
16 |
|
|
# Copyright (c) 1993 AT&T Bell Laboratories
|
17 |
|
|
# ======================================================================
|
18 |
|
|
# Permission to use, copy, modify, and distribute this software and its
|
19 |
|
|
# documentation for any purpose and without fee is hereby granted,
|
20 |
|
|
# provided that the above copyright notice appear in all copies and that
|
21 |
|
|
# both that the copyright notice and warranty disclaimer appear in
|
22 |
|
|
# supporting documentation, and that the names of AT&T Bell Laboratories
|
23 |
|
|
# any of their entities not be used in advertising or publicity
|
24 |
|
|
# pertaining to distribution of the software without specific, written
|
25 |
|
|
# prior permission.
|
26 |
|
|
#
|
27 |
|
|
# AT&T disclaims all warranties with regard to this software, including
|
28 |
|
|
# all implied warranties of merchantability and fitness. In no event
|
29 |
|
|
# shall AT&T be liable for any special, indirect or consequential
|
30 |
|
|
# damages or any damages whatsoever resulting from loss of use, data or
|
31 |
|
|
# profits, whether in an action of contract, negligence or other
|
32 |
|
|
# tortuous action, arising out of or in connection with the use or
|
33 |
|
|
# performance of this software.
|
34 |
|
|
# ======================================================================
|
35 |
|
|
|
36 |
|
|
# ----------------------------------------------------------------------
|
37 |
|
|
# COMMAND: make_toaster <name> <heat>
|
38 |
|
|
#
|
39 |
|
|
# INPUTS
|
40 |
|
|
# <name> = name of new toaster
|
41 |
|
|
# <heat> = heat setting (1-5)
|
42 |
|
|
#
|
43 |
|
|
# RETURNS
|
44 |
|
|
# name of new toaster
|
45 |
|
|
#
|
46 |
|
|
# SIDE-EFFECTS
|
47 |
|
|
# Creates a record of a new toaster with the given heat setting
|
48 |
|
|
# and an empty crumb tray.
|
49 |
|
|
# ----------------------------------------------------------------------
|
50 |
|
|
proc make_toaster {name heat} {
|
51 |
|
|
global allToasters
|
52 |
|
|
|
53 |
|
|
if {$heat < 1 || $heat > 5} {
|
54 |
|
|
error "invalid heat setting: should be 1-5"
|
55 |
|
|
}
|
56 |
|
|
set allToasters($name-heat) $heat
|
57 |
|
|
set allToasters($name-crumbs) 0
|
58 |
|
|
}
|
59 |
|
|
|
60 |
|
|
# ----------------------------------------------------------------------
|
61 |
|
|
# COMMAND: toast_bread <name> <slices>
|
62 |
|
|
#
|
63 |
|
|
# INPUTS
|
64 |
|
|
# <name> = name of toaster used to toast bread
|
65 |
|
|
# <slices> = number of bread slices (1 or 2)
|
66 |
|
|
#
|
67 |
|
|
# RETURNS
|
68 |
|
|
# current crumb count
|
69 |
|
|
#
|
70 |
|
|
# SIDE-EFFECTS
|
71 |
|
|
# Toasts bread and adds crumbs to crumb tray.
|
72 |
|
|
# ----------------------------------------------------------------------
|
73 |
|
|
proc toast_bread {name slices} {
|
74 |
|
|
global allToasters
|
75 |
|
|
|
76 |
|
|
if {[info exists allToasters($name-crumbs)]} {
|
77 |
|
|
set c $allToasters($name-crumbs)
|
78 |
|
|
set c [expr $c+$allToasters($name-heat)*$slices]
|
79 |
|
|
set allToasters($name-crumbs) $c
|
80 |
|
|
} else {
|
81 |
|
|
error "not a toaster: $name"
|
82 |
|
|
}
|
83 |
|
|
}
|
84 |
|
|
|
85 |
|
|
# ----------------------------------------------------------------------
|
86 |
|
|
# COMMAND: clean_toaster <name>
|
87 |
|
|
#
|
88 |
|
|
# INPUTS
|
89 |
|
|
# <name> = name of toaster to be cleaned
|
90 |
|
|
#
|
91 |
|
|
# RETURNS
|
92 |
|
|
# current crumb count
|
93 |
|
|
#
|
94 |
|
|
# SIDE-EFFECTS
|
95 |
|
|
# Cleans toaster by emptying crumb tray.
|
96 |
|
|
# ----------------------------------------------------------------------
|
97 |
|
|
proc clean_toaster {name} {
|
98 |
|
|
global allToasters
|
99 |
|
|
set allToasters($name-crumbs) 0
|
100 |
|
|
}
|
101 |
|
|
|
102 |
|
|
# ----------------------------------------------------------------------
|
103 |
|
|
# COMMAND: destroy_toaster <name>
|
104 |
|
|
#
|
105 |
|
|
# INPUTS
|
106 |
|
|
# <name> = name of toaster to be destroyed
|
107 |
|
|
#
|
108 |
|
|
# RETURNS
|
109 |
|
|
# nothing
|
110 |
|
|
#
|
111 |
|
|
# SIDE-EFFECTS
|
112 |
|
|
# Spills all crumbs in the toaster and then destroys it.
|
113 |
|
|
# ----------------------------------------------------------------------
|
114 |
|
|
proc destroy_toaster {name} {
|
115 |
|
|
global allToasters
|
116 |
|
|
|
117 |
|
|
if {[info exists allToasters($name-crumbs)]} {
|
118 |
|
|
puts stdout "$allToasters($name-crumbs) crumbs ... what a mess!"
|
119 |
|
|
unset allToasters($name-heat)
|
120 |
|
|
unset allToasters($name-crumbs)
|
121 |
|
|
}
|
122 |
|
|
}
|