Update of /cvsroot/scsh/scx/scheme/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv7540/scheme/xlib
Modified Files:
gcontext.scm window.scm
Log Message:
- completed get-gcontext-values and change/get-window-attributes to
pack/unpack all values correctly.
- added copy-gcontext! and copy-gcontext
- added comments.
Index: gcontext.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/gcontext.scm,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -r1.8 -r1.9
*** gcontext.scm 2001/08/29 14:47:03 1.8
--- gcontext.scm 2001/10/09 15:43:55 1.9
***************
*** 1,3 ****
! ;; ...
(define (create-gcontext drawable . args)
--- 1,7 ----
! ;; create-gcontext returns a newly create graphic context for the
! ;; specified drawable (a window or a pixmap). Optional arguments are
! ;; all attributes that can be set by the set-gcontext-xyz! functions
! ;; below. They can be specified by name: 'function 'xor. Or the last
! ;; argument can be an alist of such mappings. See XCreateGC.
(define (create-gcontext drawable . args)
***************
*** 21,25 ****
"scx_Create_Gc")
! ;; ...
(define (copy-gcontext gcontext drawable)
--- 25,30 ----
"scx_Create_Gc")
! ;; copy-gcontext returns a newly create duplicate of the given
! ;; gcontext, and assigns it to the specified drawable. See XCopyGC.
(define (copy-gcontext gcontext drawable)
***************
*** 34,54 ****
"scx_Copy_Gc")
! ;; ...
(define (get-gcontext-values gcontext)
! (let ((Xgcontext (gcontext-Xgcontext gcontext))
! (Xdisplay (display-Xdisplay (gcontext-display gcontext))))
(let ((vals (%get-gcontext-values Xgcontext Xdisplay)))
(if (not vals)
(error "cannot get gcontext values." gcontext)
(let*
! ((mod-vals (begin
! (vector-set! vals 1 ;; plane-mask
! (make-pixel (vector-ref vals 1)))
! (vector-set! vals 2 ;; foreground
! (make-pixel (vector-ref vals 2)))
! (vector-set! vals 3 ;; background
! (make-pixel (vector-ref vals 3)))
! ;; TODO: tile, stipple, font ...??
vals))
(alist
--- 39,89 ----
"scx_Copy_Gc")
! ;; copy-gcontext! copies the specified attributes from gc-from to
! ;; gc-to. The attributes have to be a list of the names in the
! ;; set-gcontext-*! functions. If that argument is not specified, then
! ;; all atributes are copied. See XCopyGC.
!
! (define (copy-gcontext! gc-from gc-to . attributes)
! (let ((attributes (if (null? attributes)
! 'all
! (car attributes))))
! (%copy-gcontext! (display-Xdisplay (gcontext-display gc-from))
! (gcontext-Xgcontext gc-from)
! (gcontext-Xgcontext gc-to)
! attributes)))
!
! (import-lambda-definition %copy-gcontext! (Xdisplay Xfrom Xto attrs)
! "scx_Copy_Gc_To_Gc")
!
! ;; get-gontext-values returns an alist of all attributes for the
! ;; specified graphic context. See the gcontext-xyz functions
! ;; below. See XGetGCValues.
(define (get-gcontext-values gcontext)
! (let* ((Xgcontext (gcontext-Xgcontext gcontext))
! (display (gcontext-display gcontext))
! (Xdisplay (display-Xdisplay display)))
(let ((vals (%get-gcontext-values Xgcontext Xdisplay)))
(if (not vals)
(error "cannot get gcontext values." gcontext)
(let*
! ((pack (lambda (i fun)
! (vector-set! vals i (fun (vector-ref vals i)))))
! (make-pixmap* (lambda (Xpixmap)
! (make-pixmap Xpixmap display #f)))
! (make-font* (lambda (Xfont)
! ; this might not work properly, see Xlib
Programming
! ; Manual chapter 5.12
! (make-font #f Xfont #f display #t)))
! (make-pixel* (lambda (Xpixel)
! (make-pixel Xpixel #f #f)))
! (mod-vals (begin
! (pack 1 make-pixel*) ;; plane-mask
! (pack 2 make-pixel*) ;; foreground
! (pack 3 make-pixel*) ;; background
! (pack 11 make-pixmap*) ;; tile
! (pack 12 make-pixmap*) ;; stipple
! (pack 15 make-font*) ;; font
! (pack 20 make-pixmap*) ;; clip-mask
vals))
(alist
***************
*** 65,70 ****
"scx_Get_Gc_Values")
- ;;...
-
(define (make-gcontext-getter name)
(lambda (gcontext)
--- 100,103 ----
***************
*** 95,99 ****
(define gcontext-dashes (make-gcontext-getter 'dashes))
! ;; ...
(define (change-gcontext gcontext . attrs)
--- 128,146 ----
(define gcontext-dashes (make-gcontext-getter 'dashes))
! ;; Alternative definition of gcontext-font. See XGcontextFromGC
! ;
! ;(define (gcontext-font gcontext)
! ; (let* ((display (gcontext-display gcontext))
! ; (Xfontstruct (%gcontext-font
! ; (display-Xdisplay display)
! ; (gcontext-Xgcontext gcontext))))
! ; (make-font #f #f Xfontstruct display #f)))
! ;
! ;(import-lambda-definition %gcontext-font (Xdisplay Xgcontext)
! ; "scx_GContext_Font") ; defined in font.c
!
! ;; change-gcontext sets some attributes of the specified graphic
! ;; context. The format of the arguments is like for
! ;; create-gcontext. See XChangeGC.
(define (change-gcontext gcontext . attrs)
***************
*** 158,162 ****
"scx_Set_Gcontext_Dashlist")
! ;; ...
(define (set-gcontext-clip-rectangles! gcontext x y rectangles ordering)
--- 205,214 ----
"scx_Set_Gcontext_Dashlist")
! ;; set-gcontext-clip-rectangles changes the clip-mask in the specified
! ;; graphic context to the list of rectangles and sets the clip
! ;; origin. Each rectangle has to be a list (x y height width). The
! ;; coordinates of the rectangles are interpreted relative to the clip
! ;; origin specified by x and y. ordering can be one of 'unsorted,
! ;; 'y-sorted, 'xy-sorted or 'xy-banded. See XSetClipRectangles.
(define (set-gcontext-clip-rectangles! gcontext x y rectangles ordering)
***************
*** 171,175 ****
"scx_Set_Gcontext_Clip_Rectangles")
! ;; ...
(define (query-best-size display width height shape)
--- 223,232 ----
"scx_Set_Gcontext_Clip_Rectangles")
! ;; query-best-size/-cursor/-tile/-stipple function returns the best or
! ;; closest size to the specified size. For 'cursor, this is the
! ;; largest size that can be fully displayed on the screen specified by
! ;; which_screen. For 'tile, this is the size that can be tiled
! ;; fastest. For 'stipple, this is the size that can be stippled
! ;; fastest. See XQueryBestSize.
(define (query-best-size display width height shape)
***************
*** 188,192 ****
(define (query-best-stipple display width height)
(query-best-size display width height 'stipple))
-
-
-
--- 245,246 ----
Index: window.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/window.scm,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -r1.11 -r1.12
*** window.scm 2001/09/20 14:41:01 1.11
--- window.scm 2001/10/09 15:43:55 1.12
***************
*** 20,24 ****
((pixmap? obj) (pixmap-Xpixmap obj))
((colormap? obj) (colormap-Xcolormap obj))
! ;; cursor...??
(else obj)))
(map cdr change-win-attr-list))))
--- 20,24 ----
((pixmap? obj) (pixmap-Xpixmap obj))
((colormap? obj) (colormap-Xcolormap obj))
! ((cursor? obj) (cursor-Xcursor obj))
(else obj)))
(map cdr change-win-attr-list))))
***************
*** 102,106 ****
((comp (lambda (i f) (vector-set! v i (f (vector-ref v i)))))
(mod-v (begin
! (comp 13 make-pixel) ;; backing-pixel
(comp 7 (lambda (Xwin) ;; root
(make-window Xwin (window-display window)
--- 102,107 ----
((comp (lambda (i f) (vector-set! v i (f (vector-ref v i)))))
(mod-v (begin
! (comp 13 (lambda (Xpixel) ;; backing-pixel
! (make-pixel Xpixel #f #f)))
(comp 7 (lambda (Xwin) ;; root
(make-window Xwin (window-display window)
|