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 / isr2defs.lisp < prev    next >
Lisp/Scheme  |  1995-04-11  |  21KB  |  578 lines
  1. ;;; -*- Mode:Common-Lisp; Package:ISR2;  Base:10 -*-
  2. ;;;
  3. ;;; isrdefs.lisp
  4. ;;; author:  Bruce Draper
  5. ;;; revisions:  John Brolio, Bob Collins, Robert Heller (ISR2)
  6. ;;; Copyright 1987 by University of Massachusetts
  7. ;;; 
  8. ;; Modifications
  9. ;; Changed DEFMACROS to #-:allegro defsubst #+:allegro defun !
  10. ;; Only use defmacros where extreme need for speed exists.
  11. ;; The new compiler is pretty decent.
  12. ;; if you call some of these like funs.
  13. ;; 
  14. ;; 1/12/88 16:04:32 Bob Collins - changed defvars of *block-area* and 
  15. ;;                                *bitplane-area* to cdefvars
  16. ;; 6/19/91          Ross Beveridge - a copy of cdefvar is now defined for ISR2
  17. ;;
  18. ;; 04/11/88 10:10:58 Robert Heller - ISR2 rewrite
  19. ;;
  20.  
  21. (in-package "ISR2")
  22.  
  23. (export '(extents extents-p byte-bound-of byte-width-of pixel-count-od minx-of miny-of
  24.       maxx-of maxy-of))
  25.  
  26. ;; These constants are not really arbitrary. *real-undefined* and 
  27. ;; *int-undefined* are the same bit pattern--
  28. ;; just interpreted differently. This allows the undefined-value bit to work
  29. ;; in the overlay plains. Additionally,
  30. ;; the *real-undefined* has a #xA in front, to match the tag bits for integer. 
  31. ;; The same is true of undefinable values.
  32. (eval-when (load eval compile)
  33.   (defconstant *undefined-datatype* 12)
  34.   (defconstant *undefinable-datatype* 13)
  35.   (defconstant *default-2index-vector-size* 256
  36.            "Initial size given to a 2index vector")
  37.   (defconstant *default-2index-vector-vector-size* 100
  38.     "Initial size given to a 2index vector vector")
  39.   ;(defconstant *real-undefined*  3.437125223e10)
  40.   (defconstant *real-undefined*  2.420126136572157e-32)
  41.   ;(defconstant *int-undefined* 16470528)
  42.   (defconstant *int-undefined* 16470525)
  43.   (defconstant *ptr-undefined* '|()|)
  44.   (defconstant *old-ptr-undefined* '*undefined*)
  45.   ;;(defconstant *real-undefinable* 1.374850089e11)
  46.   (defconstant *real-undefinable* 2.4201640462649711E-32)
  47.   (defconstant *int-undefinable* 16470784)
  48.   (defconstant *ptr-undefinable* '|)(|)
  49.   (defconstant *old-ptr-undefinable* '*undefinable*)
  50.   (defconstant *boolean-dt 0)
  51.   (DEFCONSTANT *boolean* 0) 
  52.   (defconstant *pointer-dt 1)
  53.   (DEFCONSTANT *POINTER* 1) 
  54.   (defconstant *bitplane-dt 2)
  55.   (DEFCONSTANT *BITPLANE* 2) 
  56.   (defconstant *extents-dt 3)
  57.   (DEFCONSTANT *EXTENTS* 3) 
  58.   (defconstant *int-dt 4)
  59.   (DEFCONSTANT *INTEGER* 4) 
  60.   (DEFCONSTANT *INT* 4) 
  61.   (defconstant *fixnum* 4)
  62.   (defconstant *real-dt 5)
  63.   (DEFCONSTANT *REAL* 5)
  64.   (defconstant *float* 5)
  65.   (defconstant *single-float* 5)
  66.   ;; RPH - added these three data types
  67.   (defconstant *array-dt 6)
  68.   (DEFCONSTANT *ARRAY* 6)
  69.   (defconstant *handle-dt 7)
  70.   (DEFCONSTANT *HANDLE* 7)
  71.   (defconstant *string-dt 8)
  72.   (DEFCONSTANT *string* 8)
  73.   (defconstant FIRST-DT *BOOLEAN* "First data type")
  74.   (defconstant LAST-DT  *STRING*  "Last data type")
  75.   (defconstant *type-names* 
  76.            (make-array
  77.          9
  78.          :initial-contents '("Boolean/Existence" "Pointer" "Bitplane"
  79.                      "Extents" "Int" "Real" "Array"
  80.                      "Handle" "String")))
  81.   (defconstant *type-keywords* 
  82.            (make-array
  83.          9
  84.          :initial-contents '(:Boolean :Pointer :Bitplane
  85.                      :Extents :Integer :Real :Array
  86.                      :Handle :String)))
  87.   )
  88.  
  89. (defun dt-from-keyword (keyword)
  90.   (dotimes (idt 9)
  91.      (when (eq (aref *type-keywords* idt) keyword) (return-from dt-from-keyword idt)))
  92.   nil)
  93.  
  94. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun keyword-from-dt (idt)
  95.   (if (and (>= idt FIRST-DT) (<= idt LAST-DT))
  96.       (aref *type-keywords* idt)
  97.       nil))
  98.  
  99. ;;;;
  100. ;; RPH - this structure replaces the xxx-blocks of ISR V1.
  101. ;; All Feature value vectors (including the existence vectors) will consist of a 
  102. ;; vector of these critters.
  103. ;;
  104. ;; 2index-vector is the generic structure.  The actual feature value vectors
  105. ;; will contain a "specialized" version - it will be the same structure, but
  106. ;; will have a different type name - just does an :include of this structure and
  107. ;; adds no slots of its own.  ** Note: this is tricky - I'm using the generic
  108. ;; structure's accessors on structures which are named different, but have the
  109. ;; same actual structure **
  110. ;;
  111.  
  112. (defstruct (2index-vector (:print-function print-2index-vector)
  113.               (:constructor %make-2index-vector))
  114.   "Basic 2-index vector structure.  Existence vectors and data vectors consist
  115. of a vector of these things."
  116.   (start-index 0 :type integer)
  117.   (end-index   *default-2index-vector-size* :type integer)
  118.   (data-vector (make-array *default-2index-vector-size*
  119.                :initial-element *ptr-undefined*)
  120.            :type (array * (*)))
  121.   )
  122.  
  123. ;;;;
  124. ;; specialized 2index-vectors:
  125.  
  126. (defstruct (2index-bin-vector (:include 2index-vector)
  127.                   (:print-function print-2index-vector)
  128.                   (:constructor %make-2index-bin-vector))
  129.   )
  130.  
  131. (defstruct (2index-ptr-vector (:include 2index-vector)
  132.                   (:print-function print-2index-vector)
  133.                   (:constructor %make-2index-ptr-vector))
  134.   )
  135.  
  136. (defstruct (2index-int-vector (:include 2index-vector)
  137.                   (:print-function print-2index-vector)
  138.                   (:constructor %make-2index-int-vector))
  139.   )
  140.  
  141. (defstruct (2index-real-vector (:include 2index-vector)
  142.                   (:print-function print-2index-vector)
  143.                   (:constructor %make-2index-real-vector))
  144.   )
  145.  
  146. (defstruct (2index-ary-vector (:include 2index-vector)
  147.                   (:print-function print-2index-vector)
  148.                   (:constructor %make-2index-ary-vector))
  149.   )
  150.  
  151. (defstruct (2index-bp-vector (:include 2index-vector)
  152.                   (:print-function print-2index-vector)
  153.                   (:constructor %make-2index-bp-vector))
  154.   )
  155.  
  156. (defstruct (2index-extents-vector (:include 2index-vector)
  157.                   (:print-function print-2index-vector)
  158.                   (:constructor %make-2index-extents-vector))
  159.   )
  160.  
  161. (defstruct (2index-handle-vector (:include 2index-vector)
  162.                   (:print-function print-2index-vector)
  163.                   (:constructor %make-2index-handle-vector))
  164.   )
  165.  
  166. (defstruct (2index-string-vector (:include 2index-vector)
  167.                   (:print-function print-2index-vector)
  168.                   (:constructor %make-2index-string-vector))
  169.   )
  170.  
  171. ;;;;
  172. ;; generic print function - used by all of the above.
  173.  
  174.  
  175. (defun print-2index-vector (vector-struct stream level)
  176.   (if (or (null *print-array*)
  177.       (and *print-level* (> level *print-level*)))
  178.       (format stream "#<~A (~d..~d) #>"
  179.           (type-of vector-struct)
  180.           (2index-vector-start-index vector-struct)
  181.           (2index-vector-end-index vector-struct))
  182.       (format stream "#<~A (~d..~d) ~s>"
  183.           (type-of vector-struct)
  184.           (2index-vector-start-index vector-struct)
  185.           (2index-vector-end-index vector-struct)
  186.           (2index-vector-data-vector vector-struct))
  187.       )
  188.   )
  189.  
  190.  
  191. ;; magic LISPM storage management hackery:  reserve space outside of the GCer's
  192. ;; access
  193.  
  194. #+:EXPLORER
  195. (cdefvar *2index-area* (make-area :name '2index-area :gc :static :room t))
  196. #+:EXPLORER
  197. (cdefvar *bitplane-area* (make-area :name 'bitplane-area 
  198.                           :gc :temporary :room t))
  199.  
  200. ;;;;
  201. ;; generic 2index-vector constructor.  Calls the specialized versions by casing on
  202. ;; the element-data-type.
  203.  
  204. (defun make-2index-vector (&key (vector-size *default-2index-vector-size*)
  205.                (start-index 0) (element-data-type *pointer*)
  206.                &aux #+:EXPLORER (default-cons-area *2index-area*))
  207.   #+:EXPLORER (declare (special default-cons-area))
  208.   (funcall (ecase element-data-type
  209.          (#.*pointer* #'%make-2index-ptr-vector)
  210.          (#.*array* #'%make-2index-ary-vector)
  211.          (#.*extents* #'%make-2index-extents-vector)
  212.          (#.*bitplane* #'%make-2index-bp-vector)
  213.          (#.*int* #'%make-2index-int-vector)
  214.          (#.*real* #'%make-2index-real-vector)
  215.          (#.*handle* #'%make-2index-handle-vector)
  216.          (#.*string* #'%make-2index-string-vector)
  217.          (#.*BOOLEAN* #'%make-2index-bin-vector)
  218.          )
  219.     :start-index start-index
  220.     :end-index (+ start-index vector-size)
  221.     :data-vector (make-array vector-size
  222.                  :element-type (ecase element-data-type
  223.                          ((#.*pointer*
  224.                            #.*array*
  225.                            #.*extents*
  226.                            #.*handle* #.*string*
  227.                            #.*bitplane*) t)
  228.                          (#.*real* 'single-float)
  229.                          (#.*int* #+:explorer 'fixnum
  230.                               #+user::vax '(signed-byte 32)
  231.                               #-:EXPLORER '(signed-byte 32)
  232.                               )
  233.                          (#.*BOOLEAN* 'bit))
  234.                  :initial-element (ecase element-data-type
  235.                          ((#.*pointer*
  236.                            #.*array*
  237.                            #.*extents*
  238.                            #.*handle* #.*string*
  239.                            #.*bitplane*) *ptr-undefined*)
  240.                          (#.*real* *real-undefined*)
  241.                          (#.*int* *int-undefined*)
  242.                          (#.*BOOLEAN* 0))
  243.                  )
  244.     )
  245.   )
  246.  
  247. ;;;;
  248. ;; specialized versions.  These call back the main generic version, which calls
  249. ;; the defstruct generated constructors
  250.  
  251. (defun make-2index-bin-vector (&key (vector-size *default-2index-vector-size*)
  252.                    (start-index 0))
  253.   (make-2index-vector :vector-size vector-size :start-index start-index
  254.               :element-data-type *BOOLEAN*))
  255.  
  256. (defun make-2index-int-vector (&key (vector-size *default-2index-vector-size*)
  257.                    (start-index 0))
  258.   (make-2index-vector :vector-size vector-size :start-index start-index
  259.               :element-data-type *int*))
  260.  
  261. (defun make-2index-real-vector (&key (vector-size *default-2index-vector-size*)
  262.                    (start-index 0))
  263.   (make-2index-vector :vector-size vector-size :start-index start-index
  264.               :element-data-type *real*))
  265.  
  266. (defun make-2index-ptr-vector (&key (vector-size *default-2index-vector-size*)
  267.                    (start-index 0))
  268.   (make-2index-vector :vector-size vector-size :start-index start-index
  269.               :element-data-type *pointer*))
  270.  
  271. (defun make-2index-ary-vector (&key (vector-size *default-2index-vector-size*)
  272.                    (start-index 0))
  273.   (make-2index-vector :vector-size vector-size :start-index start-index
  274.               :element-data-type *array*))
  275.  
  276. (defun make-2index-bp-vector (&key (vector-size *default-2index-vector-size*)
  277.                    (start-index 0))
  278.   (make-2index-vector :vector-size vector-size :start-index start-index
  279.               :element-data-type *bitplane*))
  280.  
  281. (defun make-2index-extents-vector (&key (vector-size *default-2index-vector-size*)
  282.                    (start-index 0))
  283.   (make-2index-vector :vector-size vector-size :start-index start-index
  284.               :element-data-type *extents*))
  285.  
  286. (defun make-2index-handle-vector (&key (vector-size *default-2index-vector-size*)
  287.                    (start-index 0))
  288.   (make-2index-vector :vector-size vector-size :start-index start-index
  289.               :element-data-type *handle*))
  290.  
  291. (defun make-2index-string-vector (&key (vector-size *default-2index-vector-size*)
  292.                    (start-index 0))
  293.   (make-2index-vector :vector-size vector-size :start-index start-index
  294.               :element-data-type *string*))
  295.  
  296. ;;;;
  297. ;; generic 2index-vector initializer.  Called by allocate-resource.
  298. ;;
  299.  
  300. (defun initialize-2index-vector (object initial-element start-index end-index)
  301.    (setf (2index-vector-start-index object) start-index)
  302.    (setf (2index-vector-end-index object) end-index)
  303.    (fill (2index-vector-data-vector object) initial-element))
  304.  
  305. ;; here are the defresource's
  306.  
  307. #+:EXPLORER
  308. (defresource 2index-int-vector
  309.          (&optional (start-index 0)
  310.             (end-index (+ start-index *default-2index-vector-size*)))
  311.    :constructor (make-2index-int-vector)
  312.    :initializer (initialize-2index-vector object *int-undefined* start-index end-index))
  313.  
  314. #+:EXPLORER
  315. (defresource 2index-real-vector
  316.          (&optional (start-index 0)
  317.             (end-index (+ start-index *default-2index-vector-size*)))
  318.    :constructor (make-2index-real-vector)
  319.    :initializer (initialize-2index-vector object *real-undefined*
  320.                       start-index end-index))
  321.  
  322. #+:EXPLORER
  323. (defresource 2index-bin-vector
  324.          (&optional (start-index 0)
  325.             (end-index (+ start-index *default-2index-vector-size*)))
  326.    :constructor (make-2index-bin-vector)
  327.    :initializer (initialize-2index-vector object 0 start-index end-index))
  328.  
  329. #+:EXPLORER
  330. (defresource 2index-ptr-vector
  331.          (&optional (start-index 0)
  332.             (end-index (+ start-index *default-2index-vector-size*)))
  333.    :constructor (make-2index-ptr-vector)
  334.    :initializer (initialize-2index-vector object *ptr-undefined* start-index end-index))
  335.  
  336. #+:EXPLORER
  337. (defresource 2index-bp-vector
  338.          (&optional (start-index 0)
  339.             (end-index (+ start-index *default-2index-vector-size*)))
  340.    :constructor (make-2index-bp-vector)
  341.    :initializer (initialize-2index-vector object *ptr-undefined* start-index end-index))
  342.  
  343. #+:EXPLORER
  344. (defresource 2index-extents-vector
  345.          (&optional (start-index 0)
  346.             (end-index (+ start-index *default-2index-vector-size*)))
  347.    :constructor (make-2index-extents-vector)
  348.    :initializer (initialize-2index-vector object *ptr-undefined* start-index end-index))
  349.  
  350. #+:EXPLORER
  351. (defresource 2index-handle-vector
  352.          (&optional (start-index 0)
  353.             (end-index (+ start-index *default-2index-vector-size*)))
  354.    :constructor (make-2index-handle-vector)
  355.    :initializer (initialize-2index-vector object *ptr-undefined* start-index end-index))
  356.  
  357. #+:EXPLORER
  358. (defresource 2index-ary-vector
  359.          (&optional (start-index 0)
  360.             (end-index (+ start-index *default-2index-vector-size*)))
  361.    :constructor (make-2index-ary-vector)
  362.    :initializer (initialize-2index-vector object *ptr-undefined* start-index end-index))
  363.  
  364. #+:EXPLORER
  365. (defresource 2index-string-vector
  366.          (&optional (start-index 0)
  367.             (end-index (+ start-index *default-2index-vector-size*)))
  368.    :constructor (make-2index-string-vector)
  369.    :initializer (initialize-2index-vector object *ptr-undefined* start-index end-index))
  370.  
  371. ;;;;
  372. ;; This structure is the vector-vector used for token value "vectors".  This is
  373. ;; just an adjustable, fill-pointer array with a lock, resource-type, and a slot
  374. ;; to hold the undefined value (saves time during lookups on undefined slots).
  375. ;;
  376.  
  377. (defstruct (2index-vector-vector (:constructor %make-2index-vector-vector))
  378.   "Double index vector structure - used for all magic vectors."
  379.   (lock)
  380.   (resource-type)
  381.   (undefined-value)
  382.   (data (make-array *default-2index-vector-vector-size*
  383.                :fill-pointer 0
  384.                :adjustable t)))
  385.  
  386. #-:EXPLORER
  387. (defun allocate-resource (type &optional (start-index 0))
  388.    (case type
  389.     (2index-int-vector
  390.         (make-2index-int-vector :start-index  start-index))
  391.     (2index-real-vector
  392.         (make-2index-real-vector :start-index  start-index))
  393.     (2index-bin-vector
  394.         (make-2index-bin-vector :start-index  start-index))
  395.     (2index-ptr-vector
  396.         (make-2index-ptr-vector :start-index  start-index))
  397.     (2index-bp-vector
  398.         (make-2index-bp-vector :start-index  start-index))
  399.     (2index-extents-vector
  400.         (make-2index-extents-vector :start-index  start-index))
  401.     (2index-ary-vector
  402.         (make-2index-ary-vector :start-index  start-index))
  403.     (2index-handle-vector
  404.         (make-2index-handle-vector :start-index  start-index))
  405.     (2index-string-vector
  406.         (make-2index-string-vector :start-index  start-index))
  407.     )
  408.     )
  409.  
  410. #-:EXPLORER
  411. (defun DEALLOCATE-RESOURCE (type object) (declare (ignore type object)) t)
  412. ;;;;
  413. ;; function to add a new chunk of memory to a vector-vector. 
  414. ;;
  415.  
  416. (defun add-2index-vector (vector-vector &optional ov)
  417.   "This function allocates new memory for a double index vector.  Only memory
  418. for the OV'th block is allocated - VECTOR-VECTOR is grown to be long enough,
  419. with NIL filler is needed."
  420.   (with-lock ((2index-vector-vector-lock vector-vector))
  421.     (let* ((vec (2index-vector-vector-data vector-vector))
  422.        (fill-ptr (fill-pointer vec))
  423.        (start-index 0)
  424.        )
  425.       (unless ov (setf ov fill-ptr))
  426.       (setf start-index (* ov *default-2index-vector-size*))
  427.       (do () ((< ov fill-ptr))
  428.       (vector-push-extend 
  429.         nil
  430.         (2index-vector-vector-data vector-vector))
  431.       (incf fill-ptr))
  432.       (setf (aref vec ov)
  433.         (allocate-resource
  434.           (2index-vector-vector-resource-type vector-vector)
  435.           start-index))
  436.       (values vector-vector (aref vec ov))
  437.       )
  438.     )
  439.   )
  440.  
  441. (defun make-2index-vector-vector (vector-type)
  442.   "This function make a fresh 2-index vector structure.  Only the header
  443. structure and base vector are allocated."
  444.   (%make-2index-vector-vector
  445.     :resource-type (ecase vector-type
  446.               (#.*BOOLEAN* '2index-bin-vector)
  447.               (#.*pointer* '2index-ptr-vector)
  448.               (#.*bitplane* '2index-bp-vector)
  449.               (#.*extents* '2index-extents-vector)
  450.               (#.*int* '2index-int-vector)
  451.               (#.*real* '2index-real-vector)
  452.               (#.*array* '2index-ary-vector)
  453.               (#.*handle* '2index-handle-vector)
  454.               (#.*string* '2index-string-vector)
  455.               )
  456.     :undefined-value (ecase vector-type
  457.               (#.*BOOLEAN* 0)
  458.               ((#.*pointer* #.*bitplane* #.*extents* #.*array* 
  459.                 #.*string* #.*handle*) *ptr-undefined*)
  460.               (#.*int* *int-undefined*)
  461.               (#.*real* *real-undefined*)
  462.               )
  463.     )
  464.   )
  465.  
  466. (defun vvref (vv i)
  467.   "VVREF VV I - return the I'th element of double index vector VV.
  468. If the I'th element does not exist, the UNDEFINED magic value is returned.
  469. (No index out-of-range error is raised or even defined - the vector is
  470. presumed to be of indefinate length)."
  471.   (let* ((outer-vec (2index-vector-vector-data vv))
  472.      (undefined (2index-vector-vector-undefined-value vv))
  473.      (ov-size (fill-pointer outer-vec))
  474.      iv ov inner-vec
  475.      )
  476.     (multiple-value-setq (ov iv)
  477.       (truncate i *default-2index-vector-size*))
  478.     (if (< ov ov-size)
  479.     (progn
  480.       (setf inner-vec (aref outer-vec ov))
  481.       (if inner-vec
  482.           (aref (2index-vector-data-vector inner-vec) iv) 
  483.           undefined))
  484.     undefined)
  485.     )
  486.   )
  487.  
  488.  
  489.  
  490. (defun set-vvref (vv i new-value)
  491.   "This is the set function for VVREF. Like VVREF, there is no index-out-of-range
  492. condition.  Instead, the vector is grown and memory is allocated when needed."
  493.   (let* ((outer-vec (2index-vector-vector-data vv))
  494.      (ov-size (fill-pointer outer-vec))
  495.      iv ov inner-vec unused
  496.      )
  497.     (multiple-value-setq (ov iv)
  498.       (truncate i *default-2index-vector-size*))
  499.     (if (< ov ov-size)
  500.     (progn (setf inner-vec (aref outer-vec ov))
  501.            (if inner-vec 
  502.            (setf (aref (2index-vector-data-vector inner-vec) iv) new-value)
  503.            (progn
  504.              (multiple-value-setq (unused inner-vec)
  505.                (add-2index-vector vv ov))
  506.              (setf (aref (2index-vector-data-vector inner-vec) iv) new-value))))
  507.     (progn
  508.       (multiple-value-setq (unused inner-vec)
  509.         (add-2index-vector vv ov))
  510.       (setf (aref (2index-vector-data-vector inner-vec) iv) new-value)))
  511.     )
  512.   )
  513.  
  514. (defsetf vvref set-vvref "SETF form for VVREF.")
  515.  
  516. (defstruct fdescr
  517.   "FDESCR (Feature descriptor) Structure.  Contains information relating to
  518. a feature (either a frame or token feature)."
  519.   type
  520.   featurename
  521.   value
  522.   docstring
  523.   if-needed
  524.   if-setting
  525.   if-getting
  526.   (lock))
  527.  
  528. ;; quick access function
  529. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun get-feature-descr-type (fdescr) (fdescr-type fdescr))
  530. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun get-feature-descr-value (fdescr) (fdescr-value fdescr))
  531. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun get-feature-descr-featurename (fdescr) (fdescr-featurename fdescr))
  532.  
  533.  
  534. (defstruct (extents (:constructor make-extents-struct))
  535.   "EXTENTS Structure.  Contains region extents info."
  536.   (byte-bound 0 :type integer)
  537.   (byte-width 0 :type integer)
  538.   (pixel-count 0 :type integer)
  539.   (minx 0 :type integer)
  540.   (miny 0 :type integer)
  541.   (maxx 0 :type integer)
  542.   (maxy 0 :type integer)
  543.   )
  544.  
  545. ;; quick access functions
  546. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun byte-bound-of (ext) (extents-byte-bound ext))
  547. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun byte-width-of (ext) (extents-byte-width ext))
  548. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun pixel-count-of (ext) (extents-pixel-count ext))
  549. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun minx-of (ext) (extents-minx ext))
  550. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun miny-of (ext) (extents-miny ext))
  551. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun maxx-of (ext) (extents-maxx ext))
  552. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun maxy-of (ext) (extents-maxy ext))
  553.  
  554. ;; error checking functions
  555. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun check-frame (frame)
  556.   (unless (frame-p frame)
  557.      (error "Argument is not a frame - ~S" frame)))
  558.  
  559. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun check-handle (handle)
  560.   (unless (handle-p handle)
  561.      (error "Argument is not a handle ~S" handle)))
  562.  
  563. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun check-index (index)
  564.   (unless (and (numberp index)(not (minusp index)))
  565.      (error "Argument is not a permissible token index, ~S" index)))
  566.  
  567. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun check-fdescr (fdescr)
  568.   (unless (fdescr-p fdescr)
  569.      (error "Argument is not an fdescr, ~S" fdescr)))
  570.  
  571. (#-(or :allegro :lispworks) defsubst #+(or :allegro :lispworks) defun token-exists-p (tok-handle)
  572.    (= (vvref (frame-token-set-existence-vector (handle-frame tok-handle))
  573.          (handle-token tok-handle))
  574.       1))
  575.  
  576.  
  577.  
  578.