67 lines
2.3 KiB
Scheme
67 lines
2.3 KiB
Scheme
;; create-pixmap-cursor returns a cursor, that was build using the
|
|
;; pixmaps src and mask, and the colors foreground and background. x
|
|
;; and y specify the hotspot of the cursor. See XCreatePixmapCursor.
|
|
|
|
(define (create-pixmap-cursor src mask x y foreground background)
|
|
(let ((display (pixmap-display src)))
|
|
(make-cursor (%create-pixmap-cursor (display-Xdisplay display)
|
|
(pixmap-Xpixmap src)
|
|
(pixmap-Xpixmap mask)
|
|
x y
|
|
(color-Xcolor foreground)
|
|
(color-Xcolor background))
|
|
display
|
|
#t)))
|
|
|
|
(define create-cursor create-pixmap-cursor) ;; for compatibility with elk
|
|
|
|
(import-lambda-definition %create-pixmap-cursor (Xdisplay src mask x y f b)
|
|
"scx_Create_Pixmap_Cursor")
|
|
|
|
;; create-glyph-cursor returns a cursor, that was build using the font
|
|
;; src, an integer src-char, a font mask, an integer mask-char, and
|
|
;; the colors foreground and background. See XCreateGlyphCursor.
|
|
|
|
(define (create-glyph-cursor src src-char mask mask-char foreground background)
|
|
(let ((display (font-display src)))
|
|
(make-cursor (%create-glyph-cursor (display-Xdisplay display)
|
|
(font-Xfont src)
|
|
src-char
|
|
(font-Xfont mask)
|
|
mask-char
|
|
(color-Xcolor foreground)
|
|
(color-Xcolor background))
|
|
display
|
|
#t)))
|
|
|
|
(import-lambda-definition %create-glyph-cursor
|
|
(Xdisplay src srcc mask maskc f b)
|
|
"scx_Create_Glyph_Cursor")
|
|
|
|
;; create-font-cursor returns a cursor, that was build with
|
|
;; create-glyph-cursor using a font named "cursor", src-char, the
|
|
;; character following src-char as mask-char, and black and as
|
|
;; foreground and background.
|
|
|
|
(define (create-font-cursor display src-char)
|
|
(let ((font (load-font display "cursor")))
|
|
(create-glyph-cursor font src-char
|
|
font (+ 1 src-char)
|
|
(create-color 0 0 0)
|
|
(create-color 65535 65535 65535))
|
|
;; elk protects that with unwind-protect, and calls unload-font to free
|
|
;; the font, but we free it anyway on garbage-collection...(??)
|
|
;;(unload-font font)
|
|
))
|
|
|
|
;; recolor-cursor resets the colors of an existing cursor. See XRecolorCursor.
|
|
|
|
(define (recolor-cursor cursor foreground background)
|
|
(%recolor-cursor (display-Xdisplay (cursor-display cursor))
|
|
(cursor-Xcursor cursor)
|
|
foreground background))
|
|
|
|
(import-lambda-definition %recolor-cursor (Xdisplay Xcursor f b)
|
|
"scx_Recolor_Cursor")
|
|
|