SV: CLOS woes

You initialize the position with constant list '(0.0 0.0 0.0),
so all objects will get the same constant.
Then destructively modify this list.

To assign a distinct list to evety instance you should write

  :initform (list 0.0 0.0 0.0)

But it will be still dangerous to destructively modify this
list, because there they be insatnces of object with constant
position:

(setq x (make-instance 'Object))

(setf (position x) '(1 2 3))

Now the position ox x is a constant, so it is dangerous to
modify it.

It is better to redefine set-position:

(defmethod set-position ((self object) x y z)
   (setf (position self) (list x y z)))


Pavel Grozman


> -----Ursprungligt meddelande-----
> FrÃ¥n: lcluke [mailto:[email protected]]
> Skickat: den 7 maj 2003 09:36
> Till: [email protected]
> Ämne: [cormanlisp] 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))))
>
>
>
> 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/
>
>
>


------------------------ 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/