From Oren@Home.csc.ti.com Thu Jan 28 15:02:49 1988
Sender: OREN@SI.csc.ti.com
Date: Thu, 28 Jan 88  13:57:13 CST
From: LaMott Oren <Oren@Home.csc.ti.com>
To: bug-clx@zermatt.lcs.mit.edu
Cc: Ekberg@tilde.csc.ti.com
Subject: CLX text-extents bug

Text-extents barfs when asked to get the extents of a character that
isn't in the font.   This version ignores non-existent characters, which
is what the server does for both QueryTextExtents and the PolyText
requests.  This also uses declare-array for the char-infos vector, which
should speed things up a bit on a Symbolics.

;; From the TEXT file
(defun text-extents-local (font sequence start end width-only-p)
  (declare (type font font)
	   (type sequence sequence)
	   (type integer start end)
	   (type boolean width-only-p))
  (declare-values width ascent descent overall-left overall-right)
  (let* ((char-infos (font-char-infos font))
	 (font-info (font-font-info font)))
    (declare (type font-info font-info))
    (declare-array vector char-infos)
    (if (zerop (length char-infos))
	;; Fixed width font
	(let* ((font-width (max-char-width font))
	       (font-ascent (max-char-ascent font))
	       (font-descent (max-char-descent font))
	       (width (* (index- end start) font-width)))
	  (declare (type int16 font-width font-ascent font-descent)
		   (type int32 width))
	  (if width-only-p
	      width
	    (values width
		    font-ascent
		    font-descent
		    (max-char-left-bearing font)
		    (+ width (- font-width) (max-char-right-bearing font)))))
      
      ;; Variable-width font
      (let* ((first-col (font-info-min-byte2 font-info))
	     (num-cols (1+ (- (font-info-max-byte2 font-info) first-col)))
	     (first-row (font-info-min-byte1 font-info))
	     (last-row (font-info-max-byte1 font-info))
	     (num-rows (1+ (- last-row first-row))))
	(declare (type card8 first-col first-row last-row)
		 (type card16 num-cols num-rows))
	(if (or (plusp first-row) (plusp last-row))
	    
	    ;; Matrix (16 bit) font
	    (macrolet ((char-info-elt (sequence elt)
			 `(let* ((char (the card16 (elt ,sequence ,elt)))
				 (row (- (ash char -8) first-row))
				 (col (- (logand char #xff) first-col)))
			    (declare (type card16 char)
				     (type int16 row col))
			    (IF (and (< -1 row num-rows) (< -1 col num-cols))
				(index* 6 (index+ (index* row num-cols) col))
			      -1))))
	      (if width-only-p
		  (do ((i start (index1+ i))
		       (width 0))
		      ((index>= i end) width)
		    (declare (type array-index i)
			     (type int32 width))
		    (let ((n (char-info-elt sequence i)))
		      (declare (type fixnum n))
		      (unless (minusp n)  ;; Ignore characters not in the font
			(incf width (the int16 (aref char-infos (index+ 2 n)))))))
		;; extents
		(do ((i start (index1+ i))
		     (width 0)
		     (ascent 0)
		     (descent 0)
		     (left #x7fff)
		     (right 0))
		    ((index>= i end)
		     (values width ascent descent left right))
		  (declare (type array-index i)
			   (type int16 ascent descent)
			   (type int32 width left right))
		  (let ((n (char-info-elt sequence i)))
		    (declare (type fixnum n))
		    (unless (minusp n) ;; Ignore characters not in the font
		      (setq left (min left (+ width (aref char-infos n))))
		      (setq right (max right (+ width (aref char-infos (index1+ n)))))
		      (incf width (aref char-infos (index+ 2 n)))
		      (setq ascent (max ascent (aref char-infos (index+ 3 n))))
		      (setq descent (max descent (aref char-infos (index+ 4 n)))))))))
	  
	  ;; Non-matrix (8 bit) font
	  ;; The code here is identical to the above, except for the following macro:
	  (macrolet ((char-info-elt (sequence elt)
		       `(let ((col (- (the card16 (elt ,sequence ,elt)) first-col)))
			  (declare (type int16 col))
			  (IF (< -1 col num-cols)
			      (index* 6 col)
			    -1))))
	    (if width-only-p
		(do ((i start (index1+ i))
		     (width 0))
		    ((index>= i end) width)
		  (declare (type array-index i)
			   (type int32 width))
		  (let ((n (char-info-elt sequence i)))
		    (declare (type fixnum n))
		    (unless (minusp n) ;; Ignore characters not in the font
		      (incf width (the int16 (aref char-infos (index+ 2 n)))))))
	      ;; extents
	      (do ((i start (index1+ i))
		   (width 0)
		   (ascent 0)
		   (descent 0)
		   (left #x7fff)
		   (right 0))
		  ((index>= i end)
		   (values width ascent descent left right))
		(declare (type array-index i)
			 (type int16 ascent descent)
			 (type int32 width left right))
		(let ((n (char-info-elt sequence i)))
		  (declare (type fixnum n))
		  (unless (minusp n) ;; Ignore characters not in the font
		    (setq left (min left (+ width (aref char-infos n))))
		    (setq right (max right (+ width (aref char-infos (index1+ n)))))
		    (incf width (aref char-infos (index+ 2 n)))
		    (setq ascent (max ascent (aref char-infos (index+ 3 n))))
		    (setq descent (max descent (aref char-infos (index+ 4 n)))))
		  ))))
	  )))))