OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [itcl/] [itcl/] [tests/] [old/] [toasters/] [Toaster.tcl] - Blame information for rev 1773

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# ----------------------------------------------------------------------
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.1.1 2002-01-16 10:24:47 markom 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
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.