CLOS woes

I am experiencing a slight problem with CLOS.

I create 2 objects, 'an-object-1' and  'an-object-2'. However when I 
set the value of the variable 'position' in 'an-object-1', it is 
also set for 'an-object-2' (even though these are two different 
objects). It seems that 'position' is acting like a class-wide 
variable and not an instance variable.

Could someone please run my code and verify these results?

-Luke

******************* Begin, program run ********************
Before variables are set...
an-object-1 = #<Object #xCBAB40>, id = OBJ-1, position = (x=0.0, 
y=0.0, z=0.0)
After variables are set...
an-object-1 = #<Object #xCBAB40>, id = OBJ-1, position = (x=0.0, y=-
5.0, z=-20.0)
(get-object *scene* 'obj-1) = #<Object #xCBAB40>, id = OBJ-1, 
position = (x=0.0, y=-5.0, z=-20.0)

Before variables are set...
an-object-2 = #<Object #xCC8580>, id = OBJ-2, position = (x=0.0, y=-
5.0, z=-20.0)
After variables are set...
an-object-2 = #<Object #xCC8580>, id = OBJ-2, position = (x=0.0, 
y=5.0, z=-20.0)
(get-object *scene* 'obj-2) = #<Object #xCC8580>, id = OBJ-2, 
position = (x=0.0, y=5.0, z=-20.0)

Compare an-object-1 in *scene* to an-object-2 in *scene*
Object: OBJ-1 - position: x=0.0, y=5.0, z=-20.0
Object: OBJ-2 - Translate: x=0.0, y=5.0, z=-20.0
NIL
******************* End, program run ********************

;;; Define classes
;;;
(defclass Object ()
    (
        (id             :accessor id            ; object identifier
                        :initform nil
                        :initarg :id)
        (position       :accessor position
                        :initform '(0.0 0.0 0.0))))    ; vector 
containing x y z
(defclass Scene ()
    (
        (objects    :accessor   objects
                    :initform   (make-hash-table)))) ; a hash-table 
of objects in the scene

;;;
;;; End classes

;;; Generic methods
;;;
(defmethod add-object ((sc scene) (obj object))
    (setf (gethash (id obj) (objects sc)) obj))

(defmethod get-object ((sc scene) id)
    (gethash id (objects sc)))

(defun new-object (identifier)
    (values (make-instance 'object :id identifier)))

(defmethod set-position ((self object) x y z)
    (setf (nth 0 (position self)) x)
    (setf (nth 1 (position self)) y)
    (setf (nth 2 (position self)) z))

(defmethod get-position-x ((self object))
        (nth 0 (position self)))

(defmethod get-position-y ((self object))
        (nth 1 (position self)))

(defmethod get-position-z ((self object))
        (nth 2 (position self)))

;;;
;;; End Generic methods
(let (
        (an-object-1 (new-object 'obj-1))
        (an-object-2 (new-object 'obj-2)))
    
    (setf *scene* (make-instance 'scene))
    
    ;; Object 1
    (format t "Before variables are set...~%")
    (format t "an-object-1 = ~A, id = ~A, position = (x=~A, y=~A, 
z=~A)~%"
        an-object-1
        (id an-object-1)
        (get-position-x an-object-1)
        (get-position-y an-object-1)
        (get-position-z an-object-1))
    
    (set-position an-object-1 0.0 -5.0 -20.0)
    (add-object *scene* an-object-1)
    
    (format t "After variables are set...~%")
    (format t "an-object-1 = ~A, id = ~A, position = (x=~A, y=~A, 
z=~A)~%"
        an-object-1
        (id an-object-1)
        (get-position-x an-object-1)
        (get-position-y an-object-1)
        (get-position-z an-object-1))
    (format t "(get-object *scene* 'obj-1) = ~A, id = ~A, position = 
(x=~A, y=~A, z=~A)~%"
        (get-object *scene* 'obj-1)
        (id (get-object *scene* 'obj-1))
        (get-position-x (get-object *scene* 'obj-1))
        (get-position-y (get-object *scene* 'obj-1))
        (get-position-z (get-object *scene* 'obj-1)))

    ;; Object 2
    (format t "~%Before variables are set...~%")
    (format t "an-object-2 = ~A, id = ~A, position = (x=~A, y=~A, 
z=~A)~%"
        an-object-2
        (id an-object-2)
        (get-position-x an-object-2)
        (get-position-y an-object-2)
        (get-position-z an-object-2))
    
    (set-position an-object-2 0.0 5.0 -20.0)
    (add-object *scene* an-object-2)
    
    (format t "After variables are set...~%")
    (format t "an-object-2 = ~A, id = ~A, position = (x=~A, y=~A, 
z=~A)~%"
        an-object-2
        (id an-object-2)
        (get-position-x an-object-2)
        (get-position-y an-object-2)
        (get-position-z an-object-2))
    (format t "(get-object *scene* 'obj-2) = ~A, id = ~A, position = 
(x=~A, y=~A, z=~A)~%"
        (get-object *scene* 'obj-2)
        (id (get-object *scene* 'obj-2))
        (get-position-x (get-object *scene* 'obj-2))
        (get-position-y (get-object *scene* 'obj-2))
        (get-position-z (get-object *scene* 'obj-2)))
        
    (format t "~%Compare an-object-1 in *scene* to an-object-2 in 
*scene*~%")
    
    (format t "Object: ~A - position: x=~A, y=~A, z=~A~%"
        (id (get-object *scene* 'obj-1))
        (get-position-x (get-object *scene* 'obj-1))
        (get-position-y (get-object *scene* 'obj-1))
        (get-position-z (get-object *scene* 'obj-1)))
            
    (format t "Object: ~A - Translate: x=~A, y=~A, z=~A~%"
        (id (get-object *scene* 'obj-2))
        (get-position-x (get-object *scene* 'obj-2))
        (get-position-y (get-object *scene* 'obj-2))
        (get-position-z (get-object *scene* 'obj-2))))


------------------------ Yahoo! Groups Sponsor ---------------------~-->
Make Money Online Auctions! Make $500.00 or We Will Give You Thirty Dollars for Trying!
http://us.click.yahoo.com/KXUxcA/fNtFAA/uetFAA/SyjtlB/TM
---------------------------------------------------------------------~->

To unsubscribe from this group, send an email to:
[email protected]

 

Your use of Yahoo! Groups is subject to http://docs.yahoo.com/info/terms/