scx/scheme/xlib/visual.scm

;; A visual information is an alist with keys of the type
;; visual-info. The corresponding values have the following meaning:
;; screen-number  the screen this visual belongs to
;; depth          the depth of the screen
;; class          one of 'direct-color 'gray-scale 'pseudo-color 
;;                'static-color 'static-gray 'true-color
;; red-mask       these masks are used for direct-color and true-color
;; green-mask     to specify which bits of the pixel value specify
;; blue-mask      red, green or blue values.
;; colormap-size  tells how many different pixel value are valid
;; bits-per-rgb   specifies how many bits in each of the red, green 
;;                and blue values in a colorcell are used to drive 
;;                the rgb gun in the screen.
;; visual         this value can be passed to other functions, e.g. 
;;                create-window.
;; visual-id      this value is not normally needed by applications.

(define-enumerated-type visual-info :visual-info
  visual-info?
  visual-infos
  visual-info-name
  visual-info-index
  (visual visual-id screen depth class red-mask green-mask blue-mask 
   colormap-size bits-per-rgp))

(define visual-info-alist->vector
  (make-enum-alist->vector
   visual-infos visual-info-index
   (lambda (i)
     (lambda (x) x))))

(define (vector->visual-info-alist vector)
  (vector-set! vector 0 (make-visual (vector-ref vector 0)))
  (map cons
       (vector->list visual-infos)
       (vector->list vector)))

;; returns a list of visual informations of visuals that match the
;; template given by visual-info-alist. the 'visual element is not
;; allowed here. See XGetVisualInfo.

(define (get-visual-info display visual-info-alist)
  (let ((res (%get-visual-info (display-Xdisplay display)
			       (visual-info-alist->vector visual-info-alist))))
    (map vector->visual-info-alist
	 (vector->list res))))

(import-lambda-definition %get-visual-info (Xdisplay v)
  "scx_Get_Visual_Info")

;; visual-id returns the id of a given visual.

(define (visual-id visual)
  (%visual-id (visual-Xvisual visual)))

(import-lambda-definition %visual-id (Xvisual)
  "scx_Visual_ID")

;; match-visual-info returns info on a matching visual or #f if none
;; exists.

(define (match-visual-info display screen-number depth class)
  (let ((res (%match-visual-info (display-Xdisplay display)
				 screen-number
				 depth
				 class)))
    (if res
	(visual-info-alist->vector res)
	res)))

(import-lambda-definition %match-visual-info (Xdisplay scrnum depth class)
  "scx_Match_Visual_Info")