1#lang racket/base 2(require ffi/unsafe 3 ffi/unsafe/define 4 ffi/unsafe/alloc 5 "utils.rkt") 6 7(provide 8 (protect-out define-x11 9 10 gdk_pixmap_new 11 gdk_window_get_display 12 gdk_drawable_get_display 13 gdk_window_get_visual 14 gdk_drawable_get_visual 15 gdk_visual_get_best 16 gdk_screen_get_root_window 17 gdk_visual_get_depth 18 gdk_x11_drawable_get_xid 19 gdk_x11_display_get_xdisplay 20 gdk_x11_visual_get_xvisual 21 gdk_x11_screen_get_screen_number 22 gdk_x11_window_get_xid 23 24 _Display 25 _Window 26 _Pixmap 27 XCreatePixmap 28 XFreePixmap 29 XCreateSimpleWindow 30 XDestroyWindow)) 31 32(define x11-lib (ffi-lib "libX11" '("6" "5" ""))) 33 34(define-ffi-definer define-x11 x11-lib 35 #:default-make-fail make-not-available) 36 37(define _GdkDrawable _pointer) 38(define _GdkDisplay (_cpointer 'GdkDisplay)) 39(define _GdkWindow (_cpointer 'GdkWindow)) 40(define _GdkScreen (_cpointer 'GdkScreen)) 41(define _GdkVisual (_cpointer 'GdkVisual)) 42(define _GdkPixmap (_cpointer 'GdkPixmap)) 43(define _Visual (_cpointer 'Visual)) 44(define _Display (_cpointer 'Display)) 45(define _Drawable _ulong) 46 47;; This should be `_ulong`, but we use pointers for various 48;; reasons, including support for dealloctaors: 49(define _Window (_cpointer 'Window)) 50(define _Pixmap (_cpointer 'Pixmap)) 51 52(define-gdk gdk_pixmap_new (_fun _GdkDrawable _int _int _int -> _GdkPixmap) 53 #:wrap (allocator gobject-unref) 54 #:make-fail make-not-available) 55 56(define-gdk gdk_drawable_get_display (_fun _GdkDrawable -> _GdkDisplay) 57 #:make-fail make-not-available) 58(define-gdk gdk_window_get_display (_fun _GdkWindow -> _GdkDisplay) 59 #:make-fail make-not-available) 60(define-gdk gdk_drawable_get_visual (_fun _GdkDrawable -> _GdkVisual) 61 #:make-fail make-not-available) 62 63(define-gdk gdk_visual_get_best (_fun -> _GdkVisual) 64 #:make-fail make-not-available) 65 66(define-gdk gdk_window_get_visual (_fun _GdkWindow -> _GdkVisual) 67 #:make-fail make-not-available) 68(define-gdk gdk_visual_get_depth (_fun _GdkVisual -> _int) 69 #:make-fail make-not-available) 70 71(define-gdk gdk_screen_get_root_window (_fun _GdkScreen -> _GdkWindow)) 72 73(define-gtk gdk_x11_window_get_xid (_fun _GdkWindow -> _Window) 74 #:make-fail make-not-available) 75(define-gdk gdk_x11_drawable_get_xid (_fun _GdkDrawable -> _Drawable) 76 #:fail (lambda () (lambda (d) 77 (cast 78 (gdk_x11_window_get_xid (cast d _GdkDrawable _GdkWindow)) 79 _pointer 80 _ulong)))) 81 82(define-gdk gdk_x11_display_get_xdisplay (_fun _GdkDisplay -> _Display) 83 #:make-fail make-not-available) 84 85(define-gdk gdk_x11_visual_get_xvisual (_fun _GdkVisual -> _Visual) 86 #:make-fail make-not-available) 87 88(define-gdk gdk_x11_screen_get_screen_number (_fun _GdkScreen -> _int) 89 #:make-fail make-not-available) 90 91(define-x11 XFreePixmap (_fun _Display _Pixmap -> _void) 92 #:wrap (deallocator cadr)) 93(define-x11 XCreatePixmap (_fun _Display _Window _int _int _int -> _Pixmap) 94 #:wrap (lambda (proc) 95 (lambda (dpy win w h d) 96 (((allocator (lambda (pixmap) 97 (XFreePixmap dpy pixmap))) 98 (lambda () 99 (proc dpy win w h d))))))) 100 101;; No finalization here, because we rely on destroying the 102;; enclosing window to release a created window, if 103;; necessary. 104(define-x11 XDestroyWindow (_fun _Display _Window -> _void)) 105(define-x11 XCreateSimpleWindow (_fun _Display _Window 106 _int _int _int _int 107 _int _long _long 108 -> _Window)) 109 110