;; Test class using a bit more complex inheritance.  Specifically illustrates use of computed initial ivar values
;; (versus simple constants), and shadowing of both ivars and methods.


(class pet (parent:) (constructor_args: petname)
  (ivars: (weight (random 50)) (name petname) (friendly (random 2)) )
  (methods: (describe () (begin (display "My name is ") (display name) (display "; I'm all of ")
                                (display weight) (display " kilos of generic pet protoplasm and I'm permanently ")
                                (if (eqv? friendly 0) (display "vicious! Grrr!") (display "happy! Let's play"))
                                (newline)))
            (feed (weight) (begin 
                             (*this* 'setweight (+ (*this* 'getweight) weight))
                             (display "gloomf! Food absorbed!") (newline)))
            (setweight (newval) (set! weight newval))
            (getweight () weight)))

(class dog (parent: pet) (constructor_args: petname petweight)
  (ivars: (weight petweight) (yappy (random 2)))
  (methods: (describe () (begin (display "Woof! I'm ") (display name) (display " the ")
                                (if (eqv? friendly 0) (display "viscious") (display "happy"))
                                (display " dog.")
                                (if (< weight 25) (begin (display " I'm a scrawny ") (display weight)
                                                         (display " pounds! Feed me!") (newline))
                                    (begin (display " At ") (display weight) 
                                           (display " pounds, I'm pretty beefy, but I'll eat...") (newline)))
                                (if (eqv? yappy 0) (display "I'm a nice quiet good doggy")
                                    (display "Yap Yap yap. I'm a yappy POS! Kick me!"))
                                (newline)))
            (feed (weight) (begin (display "Yum! Thanks! I'm so much happier") (newline)
                                  (let* ((current (*this* 'getweight))
                                         (added (round (* (/ weight current) 10))))
                                    (*this* 'setweight (+ current added)))
                                  (set! friendly 1)))
            (starve () (begin (display "I'm hungry!  I'm sure feeling testy! Grrr!")
                              (newline)
                              (set! friendly 0)))
            (bark () (begin (if (eqv? yappy 0) (display "snuffle woofle. I'm a QUIET dog!")
                                (display "yap yap yap yap yap yap yap..YIPE..don't kick so hard!"))
                            (newline)))))


(class cat (parent: pet) (constructor_args: petname hairlength)
  (ivars: (hair hairlength))
  (methods: (describe () (begin (display "Miao! I'm ") (display name) (display " the ")
                                (if (eqv? friendly 0) (display "aloof") (display "cuddly"))
                                (display " cat.")
                                (if (< weight 7) (begin (display " I'm a petite ") (display weight)
                                                         (display " pounds! Love the look!") (newline))
                                    (begin (display " At ") (display weight) 
                                           (display " pounds, I'm pretty much a bruiser alley cat") (newline)))
                                (if (eq? hair 'short) (display "Gotta love this cool short hair!")
                                    (display "Hope you like my long hair in EVERYTHING!"))
                                (newline)))
            (feed (weight) (begin (if (eqv? friendly 0) (display "What's this crap? Not worthy!")
                                      (display "Thanks, what a treat! Purr purr"))
                                  (newline)))
            (starve () (begin (if (eqv? friendly 0) (display "Like I care?  I'm going out to grab me a bird...")
                                      (display "Oh master PLEASE, don't make me beg!"))
                                  (newline)))))