home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / TCL / ITCL / _ITCL.TAR / usr / lib / itcl / demos / toasters / Toaster.tcl < prev    next >
Encoding:
Text File  |  1994-03-21  |  2.4 KB  |  76 lines
  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:  Toaster.tcl,v 1.1.1.1 1994/03/21 22:09:45 mmc 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.  
  29. itcl_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.