scsh-conservatory
/
scx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added support for colormap and gcontext. added comments.

This commit is contained in:
frese 2001-07-16 13:12:11 +00:00
parent d91d4b3d74
commit 4f7bde5ba1
1 changed files with 55 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
scheme/xlib/display.scm
View File

@ -1,5 +1,10 @@
;; Author: David Frese ;; Author: David Frese
;; open-display opens the connection to the X Server. It has one optional
;; argument: a string or a symbol specifying the name of the display. If it is
;; not specified, it defaults to the value of the DISPLAY environment variable.
;; See XOpenDisplay.
(define (open-display . args) (define (open-display . args)
(let ((display-name (if (null? args) (let ((display-name (if (null? args)
#f #f
@ -14,46 +19,51 @@
(import-lambda-definition %open-display (name) "Open_Display") (import-lambda-definition %open-display (name) "Open_Display")
;; for compatibility with elk: ;; for compatibility with elk: is that correct?? see error.c
(define set-after-function! display-set-after-function!) (define set-after-function! display-set-after-function!)
(define after-function display-after-function) (define after-function display-after-function)
;; ... ;; display-default-root-window returns the root window of the default screen.
;; See DefaultRootWindow.
(define (display-default-root-window display) (define (display-default-root-window display)
(let* ((Xdisplay (display-Xdisplay display)) (let* ((Xdisplay (display-Xdisplay display))
(Xwindow (%default-root-window Xdisplay))) (Xwindow (%default-root-window Xdisplay)))
(make-window Xwindow (make-display Xdisplay)))) (make-window Xwindow (make-display Xdisplay))))
;; for compatibility with Elk.
(define display-root-window display-default-root-window) (define display-root-window display-default-root-window)
(import-lambda-definition %default-root-window (Xdisplay) (import-lambda-definition %default-root-window (Xdisplay)
"Display_Default_Root_Window") "Display_Default_Root_Window")
;; ... ;; display-default-colormap return the default colormap for allocation on the
;; default screen of the specified display. See DefaultColormap.
(define (display-default-colormap display) (define (display-default-colormap display)
(let* ((Xdisplay (display-Xdisplay display)) (let* ((Xdisplay (display-Xdisplay display))
(Xcolormap (%default-colormap Xdisplay))) (Xcolormap (%default-colormap Xdisplay)))
;** (make-colormap 0 Xdisplay Xcolormap))) (make-colormap Xcolormap display)))
#f))
;; for compatibility with Elk.
(define display-colormap display-default-colormap) (define display-colormap display-default-colormap)
(import-lambda-definition %default-colormap (Xdisplay) (import-lambda-definition %default-colormap (Xdisplay)
"Display_Default_Colormap") "Display_Default_Colormap")
;; ... ;; display-default-gcontext return the default graphics context for the root
;; window of the default screen of the specified display. See DefaultGC.
(define (display-default-gcontext display) (define (display-default-gcontext display)
(let* ((Xdisplay (display-Xdisplay display)) (let* ((Xdisplay (display-Xdisplay display))
(Xgcontext (%default-gcontext Xdisplay))) (Xgcontext (%default-gcontext Xdisplay)))
;** (make-gcontext 0 Xdisplay Xgcontext))) (make-gcontext Xgcontext display)))
#f))
(import-lambda-definition %default-gcontext (Xdisplay) (import-lambda-definition %default-gcontext (Xdisplay)
"Display_Default_Gcontext") "Display_Default_Gcontext")
;; ... ;; display-default-depth returns the depth (number of planes) of the default
;; root window of the default screen of the specified display. See DefaultDepth.
(define (display-default-depth display) (define (display-default-depth display)
(let ((Xdisplay (display-Xdisplay display))) (let ((Xdisplay (display-Xdisplay display)))
@ -62,7 +72,8 @@
(import-lambda-definition %default-depth (Xdisplay) (import-lambda-definition %default-depth (Xdisplay)
"Display_Default_Depth") "Display_Default_Depth")
;; ... ;; display-default-screen-number returns the default screen number of the given
;; display. See DefaultScreen.
(define (display-default-screen-number display) (define (display-default-screen-number display)
(let ((Xdisplay (display-Xdisplay display))) (let ((Xdisplay (display-Xdisplay display)))
@ -71,13 +82,15 @@
(import-lambda-definition %default-screen-number (Xdisplay) (import-lambda-definition %default-screen-number (Xdisplay)
"Display_Default_Screen_Number") "Display_Default_Screen_Number")
;; ... ;; internal function
(define (check-screen-number display screen-number) (define (check-screen-number display screen-number)
(if (or (< screen-number 0) (if (or (< screen-number 0)
(>= screen-number (display-screen-count display))) (>= screen-number (display-screen-count display)))
(error "invalid screen number" screen-number))) (error "invalid screen number" screen-number)))
;; display-cells returns the number of entries in the default colormap of the
;; specified screen. See DisplayCells.
(define (display-cells display screen-number) (define (display-cells display screen-number)
(check-screen-number display screen-number) (check-screen-number display screen-number)
(%display-cells (display-Xdisplay display) screen-number)) (%display-cells (display-Xdisplay display) screen-number))
@ -85,7 +98,8 @@
(import-lambda-definition %display-cells (Xdisplay screen-number) (import-lambda-definition %display-cells (Xdisplay screen-number)
"Display_Cells") "Display_Cells")
;; ... ;; display-planes returns the depth of the root window of the specified screen.
;; See DisplayPlanes.
(define (display-planes display screen-number) (define (display-planes display screen-number)
(check-screen-number display screen-number) (check-screen-number display screen-number)
@ -94,7 +108,8 @@
(import-lambda-definition %display-planes (Xdisplay screen-number) (import-lambda-definition %display-planes (Xdisplay screen-number)
"Display_Planes") "Display_Planes")
;; ... ;; display-string returns the name of the display as a string - the same that
;; was specified with open-display. See DisplayString.
(define (display-string display) (define (display-string display)
(%display-string (display-Xdisplay display))) (%display-string (display-Xdisplay display)))
@ -103,7 +118,7 @@
"Display_String") "Display_String")
;; Display-Vendor returns a pair, whose car is the vendor identification and ;; Display-Vendor returns a pair, whose car is the vendor identification and
;; whose cdr is the release number ;; whose cdr is the release number. See DisplayVendor.
(define (display-vendor display) (define (display-vendor display)
(%display-vendor (display-Xdisplay display))) (%display-vendor (display-Xdisplay display)))
@ -120,7 +135,8 @@
(import-lambda-definition %display-protocol-version (Xdisplay) (import-lambda-definition %display-protocol-version (Xdisplay)
"Display_Protocol_Version") "Display_Protocol_Version")
;; ... ;; display-screen-count returns the number of available screen on this display.
;; See ScreenCount.
(define (display-screen-count display) (define (display-screen-count display)
(%display-screen-count (display-Xdisplay display))) (%display-screen-count (display-Xdisplay display)))
@ -137,7 +153,8 @@
(import-lambda-definition %display-image-byte-order (Xdisplay) (import-lambda-definition %display-image-byte-order (Xdisplay)
"Display_Image_Byte_Order") "Display_Image_Byte_Order")
;; ... ;; display-bitmap-unit returns the size of a bitmap's scanline unit in bits.
;; See BitmapUnit.
(define (display-bitmap-unit display) (define (display-bitmap-unit display)
(%display-bitmap-unit (display-Xdisplay display))) (%display-bitmap-unit (display-Xdisplay display)))
@ -145,7 +162,8 @@
(import-lambda-definition %display-bitmap-unit (Xdisplay) (import-lambda-definition %display-bitmap-unit (Xdisplay)
"Display_Bitmap_Unit") "Display_Bitmap_Unit")
;; ... ;; display-bitmap-bit-order return one the symbols 'lbs-first and 'msb-first.
;; See BitmapBitOrder.
(define (display-bitmap-bit-order display) (define (display-bitmap-bit-order display)
(%display-bitmap-bit-order (display-Xdisplay display))) (%display-bitmap-bit-order (display-Xdisplay display)))
@ -153,8 +171,8 @@
(import-lambda-definition %display-bitmap-bit-order (Xdisplay) (import-lambda-definition %display-bitmap-bit-order (Xdisplay)
"Display_Bitmap_Bit_Order") "Display_Bitmap_Bit_Order")
;; ... ;; display-bitmap-pad returns the number of bits that each scanline must be
;; padded. See BitmapPad.
(define (display-bitmap-pad display) (define (display-bitmap-pad display)
(%display-bitmap-pad (display-Xdisplay display))) (%display-bitmap-pad (display-Xdisplay display)))
@ -162,7 +180,8 @@
(import-lambda-definition %display-bitmap-pad (Xdisplay) (import-lambda-definition %display-bitmap-pad (Xdisplay)
"Display_Bitmap_Pad") "Display_Bitmap_Pad")
;; ... ;; display-width (-height) returns the width (height) of the screen in pixels.
;; See DisplayWidth (DisplayHeight).
(define (display-width display) (define (display-width display)
(%display-width (display-Xdisplay display))) (%display-width (display-Xdisplay display)))
@ -170,15 +189,14 @@
(import-lambda-definition %display-width (Xdisplay) (import-lambda-definition %display-width (Xdisplay)
"Display_Width") "Display_Width")
;; ...
(define (display-height display) (define (display-height display)
(%display-height (display-Xdisplay display))) (%display-height (display-Xdisplay display)))
(import-lambda-definition %display-height (Xdisplay) (import-lambda-definition %display-height (Xdisplay)
"Display_Height") "Display_Height")
;; ... ;; display-width-mm (-height-mm) returns the width (height) of the screen in
;; millimeters. See DisplayWidthMM (DisplayHeightMM).
(define (display-width-mm display) (define (display-width-mm display)
(%display-width-mm (display-Xdisplay display))) (%display-width-mm (display-Xdisplay display)))
@ -186,23 +204,13 @@
(import-lambda-definition %display-width-mm (Xdisplay) (import-lambda-definition %display-width-mm (Xdisplay)
"Display_Width_Mm") "Display_Width_Mm")
;; ...
(define (display-width-mm display)
(%display-width-mm (display-Xdisplay display)))
(import-lambda-definition %display-width-mm (Xdisplay)
"Display_Width_Mm")
;; ...
(define (display-height-mm display) (define (display-height-mm display)
(%display-height-mm (display-Xdisplay display))) (%display-height-mm (display-Xdisplay display)))
(import-lambda-definition %display-height-mm (Xdisplay) (import-lambda-definition %display-height-mm (Xdisplay)
"Display_Height_Mm") "Display_Height_Mm")
;; ... ;; See XDisplayMotionBufferSize.
(define (display-motion-buffer-size display) (define (display-motion-buffer-size display)
(%display-motion-buffer-size (display-Xdisplay display))) (%display-motion-buffer-size (display-Xdisplay display)))
@ -210,7 +218,7 @@
(import-lambda-definition %display-motion-buffer-size (Xdisplay) (import-lambda-definition %display-motion-buffer-size (Xdisplay)
"Display_Motion_Buffer_Size") "Display_Motion_Buffer_Size")
;; ... the result is unspecific ;; The display-flush-output flushes the output buffer. See XFlush.
(define (display-flush-output display) (define (display-flush-output display)
(%display-flush-output (display-Xdisplay display))) (%display-flush-output (display-Xdisplay display)))
@ -218,7 +226,9 @@
(import-lambda-definition %display-flush-output (Xdisplay) (import-lambda-definition %display-flush-output (Xdisplay)
"Display_Flush_Output") "Display_Flush_Output")
;; ... the result is unspecific ;; display-wait-output flushes the output buffer and then waits until all
;; requests have been received and processed by the X server. discard-events?
;; specifies whether the events in the queue are discarded or nor. See XSync.
(define (display-wait-output display discard-events?) (define (display-wait-output display discard-events?)
(%display-wait-output (display-Xdisplay display) (%display-wait-output (display-Xdisplay display)
@ -227,7 +237,8 @@
(import-lambda-definition %display-wait-ouput (Xdisplay discard) (import-lambda-definition %display-wait-ouput (Xdisplay discard)
"Display_Wait_Output") "Display_Wait_Output")
;; ... the result is unspecific ;; display-no-op sends a NoOperation protocol request to the X server, thereby
;; exercising the connection. See XNoOp.
(define (display-no-op display) (define (display-no-op display)
(%no-op (display-Xdisplay display))) (%no-op (display-Xdisplay display)))
@ -235,9 +246,11 @@
(import-lambda-definition %no-op (Xdisplay) (import-lambda-definition %no-op (Xdisplay)
"No_Op") "No_Op")
;; for compatibility with Elk.
(define no-op display-no-op) (define no-op display-no-op)
;; ... returns a vector of integers ;; display-list-depths returns a vector of depths (integers) that are available
;; on the specified screen. See XListDepths.
(define (display-list-depths display screen-number) (define (display-list-depths display screen-number)
(%display-list-depths (display-Xdisplay display) (%display-list-depths (display-Xdisplay display)
@ -246,10 +259,11 @@
(import-lambda-definition %display-list-depths (Xdisplay scr) (import-lambda-definition %display-list-depths (Xdisplay scr)
"List_Depths") "List_Depths")
;; for compatibility with Elk.
(define list-depths display-list-depths) (define list-depths display-list-depths)
;; ... returns a vector of lists with 3 integers (depth, bits per pixel, ;; display-list-pixmap-formats returns a vector of lists with 3 integers: depth,
;; scanline pad) ;; bits per pixel and scanline pad (See above). See XListPixmapFormats.
(define (display-list-pixmap-formats display) (define (display-list-pixmap-formats display)
(%display-list-pixmap-formats (display-Xdisplay display))) (%display-list-pixmap-formats (display-Xdisplay display)))