home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / TCL / ITCL / _ITCL.TAR / usr / lib / itcl / demos / toasters / usualway.tcl < prev   
Encoding:
Text File  |  1994-03-21  |  4.2 KB  |  123 lines
  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:  usualway.tcl,v 1.1.1.1 1994/03/21 22:09:45 mmc 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. # ----------------------------------------------------------------------
  50. proc 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. # ----------------------------------------------------------------------
  73. proc 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. # ----------------------------------------------------------------------
  97. proc 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. # ----------------------------------------------------------------------
  114. proc 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.