Category : Files from Magazines
Archive   : DDJ8705.ZIP
Filename : TELLOLST.LST

Listing 1: Composite Objects in SCOOPS

; (C) Copyright 1987 Ernest R. Tello

(define-class composite-object
(classvars class-part-name class-part-num)
(instvars (part-names (active parts get-parts add-part))
(numbers-of-parts (active '#-parts num-parts more-parts)))
(options
(gettable-variables class-part-name part-names numbers-of-parts)
settable-variables
inittable-variables))

(define human-body-parts '() )
(putprop 'human-body-parts 1 'head)
(putprop 'human-body-parts 1 'neck)
(putprop 'human-body-parts 2 'arms)
(putprop 'human-body-parts 2 'hands)
(putprop 'human-body-parts 1 'trunk)
(putprop 'human-body-parts 2 'legs)
(putprop 'human-body-parts 2 'feet)

(define (num-parts p-list)
(princ p-list))

(define part-map (proplist 'human-body-parts))

(define-class body
(classvars (class-part-name 'body-parts)(class-part-num 'human-body-parts))
(mixins composite-object))

(define body-parts '(head neck arms hands trunk legs feet))

(define-method (composite-object put-cpart-name) (new-part)
(set! body-parts
(append (eval (get-class-part-name)) (list new-part))))

(define (add-part new-part)
(append! (get-class-part-name) (list new-part)))

(define (get-parts val)
(princ val))


(define my-body
(make-instance body
'part-names body-parts
'numbers-of-parts part-map ))

(compile-class composite-object)

(compile-class body)