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 / ISR / isr2pixelmap.lisp < prev    next >
Lisp/Scheme  |  1995-04-11  |  2KB  |  57 lines
  1. ;;; -*- Mode:Common-Lisp; Package:ISR2;  Base:10 -*-
  2. ;;;
  3. ;;; isr2pixelmap.lisp
  4. ;;; author:  Robert Heller
  5. ;;; Created: Tue Jun 21 14:31:52 1988
  6. ;;; Copyright 1988 by University of Massachusetts
  7. ;;; 
  8. ;;;
  9.  
  10. (in-package "ISR2")
  11.  
  12. (export '(pixelmap-if-needed pixelmap-if-setting pixelmap-if-getting 
  13.       define-pixelmap-feature))
  14.  
  15. (defun pixelmap-if-needed (featurename frame token)
  16.   (declare (ignore featurename frame))
  17.   (let ((extents (isr2:value `(,token extents) :if-undefined nil))
  18.     (bitplane (isr2:value `(,token bitplane) :if-undefined nil)))
  19.     (unless (and extents bitplane)
  20.       (error "Pixelmap is undefined, as are extents and/or bitplane"))
  21.     (make-pixelmap :extents extents
  22.            :bitplane bitplane)))
  23.  
  24. (defun pixelmap-if-setting (oldval newval featurename frame token)
  25.   (declare (ignore oldval featurename) 
  26.        (special *store-if-needed*))
  27.   (setf *store-if-needed* nil)
  28.   (cond ((typep newval 'isr2::pixelmap)
  29.      (setf (value (list (or token frame) "EXTENTS"))
  30.            (pixelmap-extents newval)
  31.            (value (list (or token frame) "BITPLANE"))
  32.            (pixelmap-bitplane newval)))
  33.     ((eq newval :uncalculated) t)
  34.     ((eq newval :undefined) t)
  35.     ((eq newval :dummy))
  36.     (t (error "Attempt to set pixelmap to something other than a pixelmap: ~S" 
  37.           newval)))
  38.    newval)
  39.  
  40. (defun pixelmap-if-getting (value featurename frame token)
  41.   (declare (ignore value featurename))
  42.   (make-pixelmap
  43.     :extents (value (list (or token frame) "EXTENTS"))
  44.     :bitplane (value (list (or token frame) "BITPLANE"))
  45.     )
  46.   )
  47.  
  48. (defmacro define-pixelmap-feature (feature-path docstring)
  49.   "DEFINE-PIXELMAP-FEATURE feature-path docstring - define the composite feature
  50. PIXELMAP.  It is a composite feature of the EXTENTS and BITPLANE features."
  51.   `(define-feature ,feature-path ,docstring :pointer
  52.            :if-needed (list 'pixelmap-if-needed)
  53.            :if-getting (list 'pixelmap-if-getting)
  54.            :if-setting (list 'pixelmap-if-setting)))
  55.  
  56.  
  57.