home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / TCL / ITCL / _ITCL.TAR / usr / lib / itcl / demos / toasters / Hazard.tcl < prev    next >
Encoding:
Text File  |  1994-03-21  |  2.5 KB  |  79 lines
  1. # ----------------------------------------------------------------------
  2. #  PURPOSE:  Tracking for hazardous products manufactured by the
  3. #            "toaster" company.
  4. #
  5. #   AUTHOR:  Michael J. McLennan       Phone: (610)712-2842
  6. #            AT&T Bell Laboratories   E-mail: michael.mclennan@att.com
  7. #
  8. #      RCS:  Hazard.tcl,v 1.1.1.1 1994/03/21 22:09:44 mmc Exp
  9. # ----------------------------------------------------------------------
  10. #               Copyright (c) 1993  AT&T Bell Laboratories
  11. # ======================================================================
  12. # Permission to use, copy, modify, and distribute this software and its
  13. # documentation for any purpose and without fee is hereby granted,
  14. # provided that the above copyright notice appear in all copies and that
  15. # both that the copyright notice and warranty disclaimer appear in
  16. # supporting documentation, and that the names of AT&T Bell Laboratories
  17. # any of their entities not be used in advertising or publicity
  18. # pertaining to distribution of the software without specific, written
  19. # prior permission.
  20. #
  21. # AT&T disclaims all warranties with regard to this software, including
  22. # all implied warranties of merchantability and fitness.  In no event
  23. # shall AT&T be liable for any special, indirect or consequential
  24. # damages or any damages whatsoever resulting from loss of use, data or
  25. # profits, whether in an action of contract, negligence or other
  26. # tortuous action, arising out of or in connection with the use or
  27. # performance of this software.
  28. # ======================================================================
  29.  
  30. itcl_class HazardRec {
  31.     constructor {cname} {
  32.         set class $cname
  33.     }
  34.     method change {var inc} {
  35.         if {![info exists $var]} {
  36.             error "bad field \"$var\""
  37.         }
  38.         incr $var $inc
  39.     }
  40.     method report {} {
  41.         return "$class: $total produced, $actives active, $accidents accidents"
  42.     }
  43.     protected class {}
  44.     protected total 0
  45.     protected actives 0
  46.     protected accidents 0
  47. }
  48.  
  49. itcl_class Hazard {
  50.  
  51.     constructor {} {
  52.         set class [virtual info class]
  53.         if {![info exists recs($class)]} {
  54.             set recs($class) [HazardRec #auto $class]
  55.         }
  56.         $recs($class) change total +1
  57.         $recs($class) change actives +1
  58.     }
  59.     destructor {
  60.         set class [virtual info class]
  61.         $recs($class) change actives -1
  62.     }
  63.  
  64.     method accident {mesg} {
  65.         set class [virtual info class]
  66.         $recs($class) change accidents +1
  67.         puts stderr $mesg
  68.     }
  69.  
  70.     proc report {class} {
  71.         if {[info exists recs($class)]} {
  72.             return [$recs($class) report]
  73.         } else {
  74.             error "no information for class \"$class\""
  75.         }
  76.     }
  77.     common recs
  78. }
  79.