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