94 lines
3.6 KiB
Plaintext
94 lines
3.6 KiB
Plaintext
;;;;
|
|
;;;; E x a m p l e 0 . s t k
|
|
;;;;
|
|
;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
|
;;;;
|
|
;;;; Permission to use, copy, and/or distribute this software and its
|
|
;;;; documentation for any purpose and without fee is hereby granted, provided
|
|
;;;; that both the above copyright notice and this permission notice appear in
|
|
;;;; all copies and derived works. Fees for distribution or use of this
|
|
;;;; software or derived works may only be charged with express written
|
|
;;;; permission of the copyright holder.
|
|
;;;; This software is provided ``as is'' without express or implied warranty.
|
|
;;;;
|
|
;;;; Author: Erick Gallesio [eg@kaolin.unice.fr]
|
|
;;;; Creation date: 5-Aug-1994 10:30
|
|
;;;; Last file update: 27-Nov-1994 15:18
|
|
|
|
;;;; This file desmonstates the use of composite objects. First we define the class
|
|
;;;; <Car> and <Caravan>.
|
|
|
|
(define-class <Car> ()
|
|
((power :init-keyword :power :accessor power)
|
|
(driver :init-keyword :driver :accessor driver)
|
|
(color :init-keyword :color :accessor color)))
|
|
|
|
(define-class <Caravan> ()
|
|
((capacity :init-keyword :capacity :accessor capacity)
|
|
(color :init-keyword :color :accessor color)))
|
|
|
|
|
|
;;;; Hereafter is a first definition of <Camping-car>. Note that the color slot
|
|
;;;; is propagated to the color slot of the "house" and "car" components of the
|
|
;;;; camping car. Note the use of the :metaclass option for managing :propagated
|
|
;;;; slots.
|
|
|
|
(define-class <Camping-car>()
|
|
((car :getter car-of) ;; Don't redefine CAR!!!!
|
|
(house :getter house)
|
|
(color :init-keyword :color :accessor color
|
|
:allocation :propagated :propagate-to (car house)))
|
|
:metaclass <Composite-metaclass>)
|
|
|
|
;;;; Defining a composite widget requires to define a initialize method.
|
|
(define-method initialize ((self <Camping-car>) initargs)
|
|
(slot-set! self 'car (make <Car>))
|
|
(slot-set! self 'house (make <Caravan>))
|
|
(next-method))
|
|
|
|
;;;; And now we can define a camping-car
|
|
(define cc (make <Camping-car> :color "red"))
|
|
(color cc) ; ===> "red"
|
|
(color (car-of cc)) ; ===> "red"
|
|
(color (house cc)) ; ===> "red"
|
|
(slot-set! cc 'color "yellow") ; other writing: (set! (color cc) "yellow")
|
|
(color cc) ; ===> "yellow"
|
|
(color (car-of cc)) ; ===> "yellow"
|
|
(color (house cc)) ; ===> "yellow"
|
|
;;;; Of course, color of the house coud be different and we can do
|
|
(set! (color (house cc)) "green")
|
|
(color cc) ; ===> "yellow"
|
|
(color (car-of cc)) ; ===> "yellow"
|
|
(color (house cc)) ; ===> "green"
|
|
|
|
|
|
;;;; Getting or setting the power of the car with this first definition
|
|
;;;; is a little bit messy. We have to do
|
|
;;;; (set! (power (car-of cc)) 10)
|
|
;;;; To avoid this we can use a "power" propagated slot which will propagate
|
|
;;;; to the "car" component. Another way consists to use inheritance.
|
|
;;;;
|
|
;;;; Note: Purists will tell you that inheritance permits object specialization
|
|
;;;; and NOT object composition. However, we can use it here to avoid the
|
|
;;;; definition of propagated slots.
|
|
;;;;
|
|
;;;; Here is the new definition of <Camping-car>.
|
|
|
|
(define-class <Camping-car>(<Car>)
|
|
((car :getter car-of) ;; Don't redefine CAR!!!!
|
|
(house :getter house)
|
|
(color :init-keyword :color :accessor color
|
|
:allocation :propagated :propagate-to (car house)))
|
|
:metaclass <Composite-metaclass>)
|
|
|
|
;;;; initialize is unmodified (but we have to redefine it since <Camping-car>
|
|
;;;; was changed.
|
|
(define-method initialize ((self <Camping-car>) initargs)
|
|
(slot-set! self 'car (make <Car>))
|
|
(slot-set! self 'house (make <Caravan>))
|
|
(next-method))
|
|
|
|
;;;; Now we can do
|
|
|
|
(define cc2 (make <Camping-Car> :color "brown" :driver "Joe" :power 10))
|