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