1# ---------------------------------------------------------------------- 2# PURPOSE: Class definition for handling toasters via [incr Tcl]. 3# 4# AUTHOR: Michael J. McLennan Phone: (610)712-2842 5# AT&T Bell Laboratories E-mail: michael.mclennan@att.com 6# 7# RCS: $Id: Toaster.tcl,v 1.1 1998/07/27 18:41:31 stanton Exp $ 8# ---------------------------------------------------------------------- 9# Copyright (c) 1993 AT&T Bell Laboratories 10# ====================================================================== 11# Permission to use, copy, modify, and distribute this software and its 12# documentation for any purpose and without fee is hereby granted, 13# provided that the above copyright notice appear in all copies and that 14# both that the copyright notice and warranty disclaimer appear in 15# supporting documentation, and that the names of AT&T Bell Laboratories 16# any of their entities not be used in advertising or publicity 17# pertaining to distribution of the software without specific, written 18# prior permission. 19# 20# AT&T disclaims all warranties with regard to this software, including 21# all implied warranties of merchantability and fitness. In no event 22# shall AT&T be liable for any special, indirect or consequential 23# damages or any damages whatsoever resulting from loss of use, data or 24# profits, whether in an action of contract, negligence or other 25# tortuous action, arising out of or in connection with the use or 26# performance of this software. 27# ====================================================================== 28 29itcl_class Toaster { 30 inherit Appliance Hazard 31 32 constructor {config} {} 33 destructor { 34 if {$crumbs > 0} { 35 puts stdout "$crumbs crumbs ... what a mess!" 36 } 37 } 38 method config {config} {} 39 40 method toast {nslices} { 41 power [expr 0.03*$heat] 42 if {$nslices < 1 || $nslices > 2} { 43 error "bad number of slices: should be 1 or 2" 44 } 45 set crumbs [expr $crumbs+$heat*$nslices] 46 if {$crumbs >= $maxcrumbs} { 47 accident "== FIRE! FIRE! ==" 48 set crumbs $maxcrumbs 49 } 50 return [check] 51 } 52 53 method clean {} { 54 power 0.5 55 set crumbs 0 56 return [check] 57 } 58 59 method check {} { 60 set level [expr $crumbs*100.0/$maxcrumbs] 61 return [format "crumb tray: %.0f%% full" $level] 62 } 63 64 proc resize {newsize} { 65 set maxcrumbs $newsize 66 } 67 68 public heat 3 { 69 if {$heat < 1 || $heat > 5} { 70 error "invalid setting $heat: should be 1-5" 71 } 72 } 73 protected crumbs 0 74 common maxcrumbs 40 75} 76