52 lines
1.6 KiB
Scheme
52 lines
1.6 KiB
Scheme
|
(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")
|
||
|
|
|
||
|
|
(define (create-glyph-cursor src src-char mask mask-char foreground background)
|
||
|
|
(let ((display (pixmap-display src)))
|
||
|
|
(make-cursor (%create-glyph-cursor (display-Xdisplay display)
|
||
|
|
(pixmap-Xpixmap src)
|
||
|
|
src-char
|
||
|
|
(pixmap-Xpixmap 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")
|
||
|
|
|
||
|
|
(define (create-font-cursor display src-char)
|
||
|
|
(let ((font (load-font display "cursor")))
|
||
|
|
(create-glyph-cursor font src-char
|
||
|
|
font (+ 1 src-char)
|
||
|
|
(make-color 0 0 0)
|
||
|
|
(make-color 1 1 1))
|
||
|
|
;; 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)
|
||
|
|
))
|
||
|
|
|
||
|
|
(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")
|
||
|
|
|