1# ----------------------------------------------------------------------
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 1998/07/27 18:41:32 stanton 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# ----------------------------------------------------------------------
50proc 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# ----------------------------------------------------------------------
73proc 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# ----------------------------------------------------------------------
97proc 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# ----------------------------------------------------------------------
114proc 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}
123