home *** CD-ROM | disk | FTP | other *** search
/ vis-ftp.cs.umass.edu / vis-ftp.cs.umass.edu.tar / vis-ftp.cs.umass.edu / pub / Software / ASCENDER / ascendMar8.tar / UMass / base-image-patch.obsolete next >
Lisp/Scheme  |  1995-07-06  |  1KB  |  39 lines
  1. ;;from Lynn Quam at SRI, to implement base-image-list
  2.  
  3. (in-package "CME")
  4.  
  5. (defmethod  base-image ((image basic-image))
  6.   (or (internal-get-prop image :base-image)
  7.       (internal-get-prop (setq image (ic::top-of-image-hierarchy image))
  8.              :base-image)
  9.       (let* ((indir (ic::image-indirected-to image))
  10.              (geom (get-prop image :linear-geom-transform)))
  11.         (cond (indir (base-image indir))
  12.               (geom (base-image (car geom)))
  13.               ;; This requires that a base image have a :PATHNAME property,
  14.               ;; meaning that it was loaded from a file.  
  15.               ((get-prop image :pathname)
  16.                image)))))
  17.  
  18. (defmethod base-image-list ((2d-world 2d-world))
  19.   (or (get-prop 2d-world :base-image-list) ;(internal-get-prop 2d-world :base-image-list)
  20.       (loop with image-list
  21.             for image in (image-list 2d-world)
  22.             for base-image = (base-image image)
  23.             when base-image
  24.               do (pushnew base-image image-list)
  25.             finally (return image-list)))) 
  26.  
  27.  
  28. (defun working-image (2dw)
  29.    (car (base-image-list 2dw)))
  30.  
  31. ;;
  32. ;; Now define this as a foreign function that can be called
  33. ;; from the umass 'C' routines.
  34. ;;
  35. (def-foreign-callable-switch (base-work-image (:name "working_image")
  36.                     (:return-type c-handle))
  37.                 ((arg_0 c-handle))
  38.                 (cme::working-image arg_0))
  39.