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
/
ascender.tar.Z
/
ascender.tar
/
base-image-patch.obsolete
next >
Wrap
Lisp/Scheme
|
1995-07-06
|
1KB
|
39 lines
;;from Lynn Quam at SRI, to implement base-image-list
(in-package "CME")
(defmethod base-image ((image basic-image))
(or (internal-get-prop image :base-image)
(internal-get-prop (setq image (ic::top-of-image-hierarchy image))
:base-image)
(let* ((indir (ic::image-indirected-to image))
(geom (get-prop image :linear-geom-transform)))
(cond (indir (base-image indir))
(geom (base-image (car geom)))
;; This requires that a base image have a :PATHNAME property,
;; meaning that it was loaded from a file.
((get-prop image :pathname)
image)))))
(defmethod base-image-list ((2d-world 2d-world))
(or (get-prop 2d-world :base-image-list) ;(internal-get-prop 2d-world :base-image-list)
(loop with image-list
for image in (image-list 2d-world)
for base-image = (base-image image)
when base-image
do (pushnew base-image image-list)
finally (return image-list))))
(defun working-image (2dw)
(car (base-image-list 2dw)))
;;
;; Now define this as a foreign function that can be called
;; from the umass 'C' routines.
;;
(def-foreign-callable-switch (base-work-image (:name "working_image")
(:return-type c-handle))
((arg_0 c-handle))
(cme::working-image arg_0))