next up previous contents
Next: Test of `animal-shelter' Up: 2nd example of object Previous: Class `cat'   Contents

Class `animal-shelter'


(define make-shelter
  (lambda()
    (define animals nil)
    (define super (make-base-object))
;
    (define accept
      (lambda(ananimal)
        (define xanimal (locate (lambda(x) (equal ananimal x)) animals))
        (if (equal xanimal false)
            ((lambda()
               (define animals (cons ananimal animals))
               true))
            false)))
;
    (define dismiss
      (lambda(ananimal)
        (define xanimal (locate (lambda(x) (equal ananimal x)) animals))
        (if (equal xanimal false)
            false
            ((lambda()
               (define animals (remove ananimal animals))
               true)))))
;
    (define find
      (lambda(aname)
        (define xanimal (locatex (lambda(x) 
                                 (equal aname ((x 'get-name)))) 
                               animals))
        xanimal))
;
    (define display
      (lambda()
        (for-each (lambda(x) ((x 'who-are-you))) animals)))
;
    (define self
      (lambda(msg)
        (if (equal msg 'accept)
            accept
            (if (equal msg 'dismiss)
                dismiss
                (if (equal msg 'find)
                    find
                    (if (equal msg 'display)
                        display
                        (super msg)))))))
     self))



Georg P. Loczewski 2004-03-05


Impressum und Datenschutz