;; A visual information is an alist with the following keys:
;; '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.

;; returns a list of visual informations that match the template given
;; by args. args can consist of the same fields as a visual
;; information (see above) except 'visual that may not be
;; specified. But usually only the fields 'screen 'depth and 'class
;; make sense. See create-window for the syntax of args.

(define (get-visual-info display . args)
  (let* ((alist (named-args->alist args))
	 (vector (pack-visual-info alist)))
    (let ((res (%get-visual-info (display-Xdisplay display)
				 vector)))
      (map unpack-visual-info 
	   (vector->list res)))))

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

(define (pack-visual-info vi)
  (let ((mapping (map cons 
		      '(visual visual-id screen-number depth class 
			       red-mask green-mask blue-mask colormap-size 
			       bits-per-rgb)
		      '(0 1 2 3 4 5 6 7 8 9)))
	(r (make-vector 10 #f)))
    (for-each (lambda (p)
		(vector-set! r (cdr (assq (car p) mapping))
			     (cdr p)))
	      vi)
    r))

(define (unpack-visual-info v)
  (vector-set! v 0 (make-visual (vector-ref v 0)))
  (map cons
       '(visual visual-id screen-number depth class red-mask green-mask
		blue-mask colormap-size bits-per-rgb)
       (vector->list v)))

;; 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
	(unpack-visual-info res)
	res)))

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