itcl class example

itcl class example

package require Itcl

itcl::class Animal {
  variable name
  variable knowledge
  variable habitat
  variable topSpeed
  variable color
  variable picture

  method answer: {aString}
  method name: {aString}
  method talk {}
  method habitat: {aHabitat}
  method learn:action: {aString aBlock}
  method reset {}
  method reactTo: {aWord}
}

itcl::class Bird {
  inherit Animal
  variable flying
}

itcl::class Parrot {
  inherit Bird
  variable vocabulary
 
  method talk {}
  method vocabulary: {aString}
}

itcl::class Penguin {
  inherit Bird
}

itcl::class Mammal {
  inherit Animal
}

itcl::class Dog {
  inherit Mammal
  variable barksAlot
 
  method bark {}
  method beNoisy {}   
  method beQuiet {}   
  method talk {}
}

itcl::class Whale {
  inherit Mammal
}


itcl::body Animal::answer: {aString} {
  # "Display a message for the receiver animal
  #  on the Transcript window, consisting
  #  of the animal's class name and name preceding
  #  aString."
  puts "[$this info class] $name: $aString"}

itcl::body Animal::name: {aString} {
  # "Change the receiver animal's name to aString."
  set name $aString}

itcl::body Animal::talk {} {
  # "Display a message that the receiver can't talk."
  $this answer: "I can't talk"}



itcl::body Parrot::talk {} {
  # "Display a message containing the receiver
  #  parrot's vocabulary."
  $this answer: $vocabulary}
   
itcl::body Parrot::vocabulary: {aString} {
  # "Change the receiver parrot's vocabulary
  #  to aString."
  set vocabulary $aString}



itcl::body Dog::bark {} {
  #    "Have the receiver dog bark by ringing the bell
  #     and displaying a bark message."
  puts -nonewline "\a"    ;# Terminal bell
  if {$barksAlot} {
    $this answer: "Bow Wow, Bow Wow, Bow Wow!!"
  } else {
    $this answer: "Woof"
  }}
 
itcl::body Dog::beNoisy {} {
  #    "Change the status of the receiver dog to noisy."
  set barksAlot 1
  $this answer: "I'll bark a lot"}
   
itcl::body Dog::beQuiet {} {
  #    "Change the status of the receiver dog to quiet."
  set barksAlot 0
  $this answer: "I won't bark much"}
   
itcl::body Dog::talk {} {
  #    "Have the receiver dog talk by barking unless
  #     barksAlot is nil, in which case the superclass
  #     can decide how to talk."
  if {[info exists barksAlot]} {
    $this bark
  } else {
    chain   ;# super talk
  }}

 
  # "creating animals"
  Dog Snoopy
  Snoopy name: "Snoopy"
  Snoopy beQuiet
  Dog Lassie
  Lassie name: "Lassie"
  Lassie beNoisy
  Penguin Wally
  Wally name: "Wally"
  Parrot Polly
  Polly name: "Polly"
  Polly vocabulary: "Polly want a Cracker"
  Whale Moby
  Moby name: "Moby"
 
 
  # "let's hear them talk"
  Lassie talk
  Snoopy talk
  Wally talk
  Polly talk; Polly talk; Polly talk
  Polly vocabulary: "Screeech@#!? Don''t bother me!"
  Polly talk
  Moby talk
  Snoopy beNoisy; Snoopy talk
  Lassie beQuiet; Lassie talk