73 lines
2.5 KiB
Scheme
73 lines
2.5 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 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")
|