110 lines
3.4 KiB
Racket
110 lines
3.4 KiB
Racket
#lang racket/base
|
|
(require ffi/unsafe
|
|
ffi/unsafe/define
|
|
ffi/unsafe/alloc
|
|
"utils.rkt")
|
|
|
|
(provide
|
|
(protect-out define-x11
|
|
|
|
gdk_pixmap_new
|
|
gdk_window_get_display
|
|
gdk_drawable_get_display
|
|
gdk_window_get_visual
|
|
gdk_drawable_get_visual
|
|
gdk_visual_get_best
|
|
gdk_screen_get_root_window
|
|
gdk_visual_get_depth
|
|
gdk_x11_drawable_get_xid
|
|
gdk_x11_display_get_xdisplay
|
|
gdk_x11_visual_get_xvisual
|
|
gdk_x11_screen_get_screen_number
|
|
gdk_x11_window_get_xid
|
|
|
|
_Display
|
|
_Window
|
|
_Pixmap
|
|
XCreatePixmap
|
|
XFreePixmap
|
|
XCreateSimpleWindow
|
|
XDestroyWindow))
|
|
|
|
(define x11-lib (ffi-lib "libX11" '("6" "5" "")))
|
|
|
|
(define-ffi-definer define-x11 x11-lib
|
|
#:default-make-fail make-not-available)
|
|
|
|
(define _GdkDrawable _pointer)
|
|
(define _GdkDisplay (_cpointer 'GdkDisplay))
|
|
(define _GdkWindow (_cpointer 'GdkWindow))
|
|
(define _GdkScreen (_cpointer 'GdkScreen))
|
|
(define _GdkVisual (_cpointer 'GdkVisual))
|
|
(define _GdkPixmap (_cpointer 'GdkPixmap))
|
|
(define _Visual (_cpointer 'Visual))
|
|
(define _Display (_cpointer 'Display))
|
|
(define _Drawable _ulong)
|
|
|
|
;; This should be `_ulong`, but we use pointers for various
|
|
;; reasons, including support for dealloctaors:
|
|
(define _Window (_cpointer 'Window))
|
|
(define _Pixmap (_cpointer 'Pixmap))
|
|
|
|
(define-gdk gdk_pixmap_new (_fun _GdkDrawable _int _int _int -> _GdkPixmap)
|
|
#:wrap (allocator gobject-unref)
|
|
#:make-fail make-not-available)
|
|
|
|
(define-gdk gdk_drawable_get_display (_fun _GdkDrawable -> _GdkDisplay)
|
|
#:make-fail make-not-available)
|
|
(define-gdk gdk_window_get_display (_fun _GdkWindow -> _GdkDisplay)
|
|
#:make-fail make-not-available)
|
|
(define-gdk gdk_drawable_get_visual (_fun _GdkDrawable -> _GdkVisual)
|
|
#:make-fail make-not-available)
|
|
|
|
(define-gdk gdk_visual_get_best (_fun -> _GdkVisual)
|
|
#:make-fail make-not-available)
|
|
|
|
(define-gdk gdk_window_get_visual (_fun _GdkWindow -> _GdkVisual)
|
|
#:make-fail make-not-available)
|
|
(define-gdk gdk_visual_get_depth (_fun _GdkVisual -> _int)
|
|
#:make-fail make-not-available)
|
|
|
|
(define-gdk gdk_screen_get_root_window (_fun _GdkScreen -> _GdkWindow))
|
|
|
|
(define-gtk gdk_x11_window_get_xid (_fun _GdkWindow -> _Window)
|
|
#:make-fail make-not-available)
|
|
(define-gdk gdk_x11_drawable_get_xid (_fun _GdkDrawable -> _Drawable)
|
|
#:fail (lambda () (lambda (d)
|
|
(cast
|
|
(gdk_x11_window_get_xid (cast d _GdkDrawable _GdkWindow))
|
|
_pointer
|
|
_ulong))))
|
|
|
|
(define-gdk gdk_x11_display_get_xdisplay (_fun _GdkDisplay -> _Display)
|
|
#:make-fail make-not-available)
|
|
|
|
(define-gdk gdk_x11_visual_get_xvisual (_fun _GdkVisual -> _Visual)
|
|
#:make-fail make-not-available)
|
|
|
|
(define-gdk gdk_x11_screen_get_screen_number (_fun _GdkScreen -> _int)
|
|
#:make-fail make-not-available)
|
|
|
|
(define-x11 XFreePixmap (_fun _Display _Pixmap -> _void)
|
|
#:wrap (deallocator cadr))
|
|
(define-x11 XCreatePixmap (_fun _Display _Window _int _int _int -> _Pixmap)
|
|
#:wrap (lambda (proc)
|
|
(lambda (dpy win w h d)
|
|
(((allocator (lambda (pixmap)
|
|
(XFreePixmap dpy pixmap)))
|
|
(lambda ()
|
|
(proc dpy win w h d)))))))
|
|
|
|
;; No finalization here, because we rely on destroying the
|
|
;; enclosing window to release a created window, if
|
|
;; necessary.
|
|
(define-x11 XDestroyWindow (_fun _Display _Window -> _void))
|
|
(define-x11 XCreateSimpleWindow (_fun _Display _Window
|
|
_int _int _int _int
|
|
_int _long _long
|
|
-> _Window))
|
|
|