123 lines
4.4 KiB
Scheme
123 lines
4.4 KiB
Scheme
;; 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 the visual-class (see below)
|
|
;; 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-syntax make-visual-info-alist
|
|
(syntax-rules
|
|
()
|
|
((make-visual-info-alist (attr arg) rest ...)
|
|
(cons (cons (visual-info attr) arg)
|
|
(make-visual-info-alist rest ...)))
|
|
((make-visual-info-alist)
|
|
'())))
|
|
|
|
(define (get-visual-info display visual-info-alist)
|
|
(let ((res (%get-visual-info (display-Xdisplay display)
|
|
(visual-info-alist->integer+vector
|
|
visual-info-alist))))
|
|
(map (lambda (p)
|
|
(cons (make-visual (car p))
|
|
(integer+vector->visual-info-alist (cdr p))))
|
|
(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 a pair of a visual that matches the given
|
|
;; criteria and a visual-info-alist of it.#f is returned if no such
|
|
;; visual exists.
|
|
|
|
(define (match-visual-info display screen-number depth class)
|
|
(let ((res (%match-visual-info (display-Xdisplay display)
|
|
screen-number
|
|
depth
|
|
(visual-class->integer class))))
|
|
(if res
|
|
(cons (make-visual (car res))
|
|
(visual-info-alist->integer+vector (cdr res)))
|
|
res)))
|
|
|
|
(import-lambda-definition %match-visual-info (Xdisplay scrnum depth class)
|
|
"scx_Match_Visual_Info")
|
|
|
|
;; *******************************************************************
|
|
|
|
(define-enumerated-type visual-class :visual-class
|
|
visual-class? visual-classs visual-class-name visual-class-index
|
|
(static-gray gray-scale static-color pseudo-color true-color direct-color))
|
|
|
|
(define (integer->visual-class int)
|
|
(vector-ref visual-classs int))
|
|
|
|
(define (visual-class->integer v)
|
|
(visual-class-index v))
|
|
|
|
;; 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-id screen depth class red-mask green-mask blue-mask
|
|
colormap-size bits-per-rgp))
|
|
|
|
(define visual-info-alist->integer+vector
|
|
(make-enum-alist->integer+vector
|
|
visual-infos visual-info-index
|
|
(lambda (v)
|
|
(cond
|
|
((eq? v (visual-info class))
|
|
visual-class->integer)
|
|
(else (lambda (x) x))))))
|
|
|
|
(define integer+vector->visual-info-alist
|
|
(make-integer+vector->enum-alist
|
|
visual-infos visual-info-index
|
|
(lambda (v)
|
|
(cond
|
|
((eq? v (visual-info class))
|
|
integer->visual-class)
|
|
(else (lambda (x) x))))))
|
|
|