Return-Path: Received: from H.GP.CS.CMU.EDU by A.GP.CS.CMU.EDU id aa12513; 13 Sep 95 11:02:04 EDT Received: from moon.src.honeywell.com by H.GP.CS.CMU.EDU id aa13608; 13 Sep 95 11:01:25 EDT Return-Path: Received: from nidhug (nidhug.src.honeywell.com) by moon.src.honeywell.com (4.1/smail2.6.3/SRCv0.25); Wed, 13 Sep 95 10:01:21 CDT id AA28009 for garnet-users@h.gp.cs.cmu.edu at h.gp.cs.cmu.edu Posted-Date: Wed, 13 Sep 95 09:59:47 CDT Received: by nidhug (4.1/SMI-3.2) id AA13804; Wed, 13 Sep 95 09:59:47 CDT Date: Wed, 13 Sep 95 09:59:47 CDT From: "Robert P. Goldman" Message-Id: <9509131459.AA13804@nidhug> To: garnet-users@H.GP.CS.CMU.EDU Cc: Andrew.Mickish@cs.cmu.edu Subject: patch for True Color displays Reply-To: Robert Goldman Attached is a patch file that can be applied by going to your garnet 3.0/src directory and running patch. It fixes two problems that keep Garnet from handling True Color displays: 1. [thanks to Nick Levine] Does a better job of checking the X display visual-info than before (previously didn't consider the possibility of :true-color). 2. Tracks Garnet's use of colormap entries using a hash table instead of a fixed-size array (of size 256). More flexible, because independent of actual size of underlying colormap. Andrew --- any chance that you could drop this into the 3.0 patches subdirectory of the distribution directory? Please let me know if this change causes anyone any problems. Best, Robert ---------------------------------------------------------------------- diff -c opal.orig/create-instances.lisp opal/create-instances.lisp *** opal.orig/create-instances.lisp Wed Sep 13 09:35:17 1995 --- opal/create-instances.lisp Wed Sep 13 09:38:23 1995 *************** *** 19,24 **** --- 19,26 ---- ;;; Change Log: ;;; date who what ;;; ---- --- ---- + ;;; 12-Sep-95 goldman Changed the way colormap entries are tracked in + ;;; from using a fixed-size array to using a hash-table. ;;; 25-May-94 amickish New :max-char-ascent/descent formulas for fonts ;;; 19-Apr-94 amickish Reset first-time in first-allocatable-colormap-index ;;; 5-Mar-94 amickish Used names for font slot type declarations *************** *** 391,399 **** (if (and old-index (>= old-index (first-allocatable-colormap-index root-window)) ! (zerop (decf (aref *colormap-index-table* old-index)))) (gem:colormap-property root-window :FREE-COLORS (list old-index))) ! (incf (aref *colormap-index-table* new-index))) new-index)))) --- 393,405 ---- (if (and old-index (>= old-index (first-allocatable-colormap-index root-window)) ! (zerop (decf (gethash old-index *colormap-index-table*))) ! ; (zerop (decf (aref *colormap-index-table* old-index))) ! ) (gem:colormap-property root-window :FREE-COLORS (list old-index))) ! (incf (gethash new-index *colormap-index-table* 0)) ! ; (incf (aref *colormap-index-table* new-index)) ! ) new-index)))) *************** *** 403,409 **** (dolist (device (g-value DEVICE-INFO :active-devices)) (let ((root-window (g-value device :root-window))) (if (and index ! (zerop (decf (aref *colormap-index-table* index))) (>= index (first-allocatable-colormap-index root-window))) (gem:colormap-property root-window :FREE-COLORS (list index))))))) --- 409,417 ---- (dolist (device (g-value DEVICE-INFO :active-devices)) (let ((root-window (g-value device :root-window))) (if (and index ! ;;replaced the old array with a hash-table ! (zerop (decf (gethash old-index *colormap-index-table*))) ! ; (zerop (decf (aref *colormap-index-table* index))) (>= index (first-allocatable-colormap-index root-window))) (gem:colormap-property root-window :FREE-COLORS (list index))))))) diff -c opal.orig/defs.lisp opal/defs.lisp *** opal.orig/defs.lisp Wed Sep 13 09:35:28 1995 --- opal/defs.lisp Wed Sep 13 09:39:25 1995 *************** *** 1,4 **** ! s;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: OPAL; Base: 10 -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The Garnet User Interface Development Environment. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --- 1,4 ---- ! ;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: OPAL; Base: 10 -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The Garnet User Interface Development Environment. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; *************** *** 17,22 **** --- 17,26 ---- ;;; Change Log: ;;; date who what ;;; ---- --- ---- + ;;; 12-Sep-95 goldman Changed the way colormap entries are tracked in + ;;; from using a fixed-size array to using a hash-table. + ;;; Applied a patch from Nick Levine that makes it + ;;; possible for garnet to deal with True Color displays. ;;; 25-May-94 amickish Made setf of *function-alist* a GEM method ;;; 17-Dec-93 amickish :x-image ---> :device-image in HALFTONE defstruct ;;; 5-Dec-93 amickish Removed Do-Defs-Initializations (temporary GEM fn) *************** *** 101,106 **** --- 105,117 ---- ;;; *function-alist* ;;; 14-Jun-89 koz Created. Simply extracted all the def* from all the ;;; Opal files. No modifications were made to them. + + ;;;--------------------------------------------------------------------------- + ;;; Local changes + ;;; [1995/09/11:goldman] incorporated Nick Levine's patch to determine + ;;; whether we have a color screen. + ;;;--------------------------------------------------------------------------- + (in-package "OPAL") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; *************** *** 295,304 **** (defvar *copy*) ;; Have to figure out what this really is. ! (defvar *colormap-index-table-size* 256) (defvar *colormap-index-table* ! (make-array *colormap-index-table-size* :initial-element 0)) (defvar *is-this-a-color-screen?* nil) (defvar *HP-display-type?* nil) --- 306,321 ---- (defvar *copy*) + ;;replaced old *colormap-index-table* in array form with a hash-table + ;;[1995/09/12:goldman] ;; Have to figure out what this really is. ! ;(defvar *colormap-index-table-size* 256) ! ;(defvar *colormap-index-table* ! ; (make-array *colormap-index-table-size* :initial-element 0)) (defvar *colormap-index-table* ! ;;arguments to make-hash-table NOT well thought out! [1995/09/12:goldman] ! (make-hash-table :size 256)) ! (defvar *is-this-a-color-screen?* nil) (defvar *HP-display-type?* nil) *************** *** 331,344 **** ;; This is really dumb, but it's the only way I can think of ;; to find out if the screen is color or not. ! (let* ((*print-pretty* NIL) ! (colormap-string (string-upcase ! (princ-to-string opal::*default-x-colormap*)))) ! (if (or (search "PSEUDO-COLOR" colormap-string) ! (search "DIRECT-COLOR" colormap-string) ! (search "GRAY-SCALE" colormap-string)) ! (setq *is-this-a-color-screen?* t) ! (setq *is-this-a-color-screen?* nil))) (with-constants-disabled (s-value opal::COLOR :color-p *is-this-a-color-screen?*)) (setq *HP-display-type?* (and *is-this-a-color-screen?* (zerop *black*))) --- 348,367 ---- ;; This is really dumb, but it's the only way I can think of ;; to find out if the screen is color or not. ! ; (let* ((*print-pretty* NIL) ! ; (colormap-string (string-upcase ! ; (princ-to-string opal::*default-x-colormap*)))) ! ; (if (or (search "PSEUDO-COLOR" colormap-string) ! ; (search "DIRECT-COLOR" colormap-string) ! ; (search "GRAY-SCALE" colormap-string)) ! ; (setq *is-this-a-color-screen?* t) ! ; (setq *is-this-a-color-screen?* nil))) ! ;;incorporated Nick Levine's patch into the code ! ;;[1995/09/11:goldman] ! (setq *is-this-a-color-screen?* ! (member (xlib::visual-info-class ! (xlib::screen-root-visual-info *default-x-screen*)) ! '(:pseudocolor :direct-color :static-color :true-color))) (with-constants-disabled (s-value opal::COLOR :color-p *is-this-a-color-screen?*)) (setq *HP-display-type?* (and *is-this-a-color-screen?* (zerop *black*))) diff -c opal.orig/open-and-close.lisp opal/open-and-close.lisp *** opal.orig/open-and-close.lisp Wed Sep 13 09:31:24 1995 --- opal/open-and-close.lisp Wed Sep 13 09:40:41 1995 *************** *** 22,27 **** --- 22,30 ---- ;;; #| CHANGE LOG: + 12-Sep-95 goldman Had to change the way reconnection is done to + reflect the fact that *colormap-index-table* + is now a hash table instead of an array. 17-Apr-94 amickish Restored s-value of :lineage to NIL when disconnect; Destroyed colormap slots after all. 25-Mar-94 amickish Eliminated redefinition warnings when reconnecting *************** *** 181,188 **** (when (kr:g-cached-value w :display-info) (kr:s-value w :display-info nil))) ;;; Clear all colors. ! (dotimes (n *colormap-index-table-size*) ! (setf (aref *colormap-index-table* n) 0)) (setq *garnet-has-been-disconnected* T)) --- 184,194 ---- (when (kr:g-cached-value w :display-info) (kr:s-value w :display-info nil))) ;;; Clear all colors. ! ; (dotimes (n *colormap-index-table-size*) ! ; (setf (aref *colormap-index-table* n) 0)) ! ;;we can do this simpler thing because we use a default value of zero ! ;;for the table entries [1995/09/12:goldman] ! (setf *colormap-index-table* (make-hash-table :size 256)) (setq *garnet-has-been-disconnected* T))