1 #define CAML_NAME_SPACE
4 #include <X11/cursorfont.h>
9 #include <caml/alloc.h>
10 #include <caml/memory.h>
11 #include <caml/unixsupport.h>
13 static const int shapes
[] = {
14 XC_left_ptr
, XC_hand2
, XC_exchange
, XC_fleur
, XC_xterm
17 #define CURS_COUNT (sizeof (shapes) / sizeof (shapes[0]))
24 Cursor curs
[CURS_COUNT
];
27 static void initcurs (void)
29 for (size_t n
= 0; n
< CURS_COUNT
; ++n
) {
30 glx
.curs
[n
] = XCreateFontCursor (glx
.dpy
, shapes
[n
]);
34 CAMLprim value
ml_glxinit (value display_v
, value wid_v
, value screen_v
)
36 CAMLparam3 (display_v
, wid_v
, screen_v
);
38 glx
.dpy
= XOpenDisplay (String_val (display_v
));
40 caml_failwith ("XOpenDisplay");
43 int attribs
[] = { GLX_RGBA
, GLX_DOUBLEBUFFER
, None
};
44 glx
.visual
= glXChooseVisual (glx
.dpy
, Int_val (screen_v
), attribs
);
46 XCloseDisplay (glx
.dpy
);
47 caml_failwith ("glXChooseVisual");
52 glx
.wid
= Int_val (wid_v
);
53 CAMLreturn (Val_int (glx
.visual
->visualid
));
56 CAMLprim
void ml_glxcompleteinit (void)
58 glx
.ctx
= glXCreateContext (glx
.dpy
, glx
.visual
, NULL
, True
);
60 caml_failwith ("glXCreateContext");
66 if (!glXMakeCurrent (glx
.dpy
, glx
.wid
, glx
.ctx
)) {
67 glXDestroyContext (glx
.dpy
, glx
.ctx
);
69 caml_failwith ("glXMakeCurrent");
73 CAMLprim
void ml_setcursor (value cursor_v
)
75 CAMLparam1 (cursor_v
);
76 size_t cursn
= Int_val (cursor_v
);
78 if (cursn
>= CURS_COUNT
) caml_failwith ("cursor index out of range");
79 XDefineCursor (glx
.dpy
, glx
.wid
, glx
.curs
[cursn
]);
84 CAMLprim
void ml_swapb (void)
86 glXSwapBuffers (glx
.dpy
, glx
.wid
);
89 void (*wsigladdr (const char *name
)) (void)
91 return glXGetProcAddress ((const GLubyte
*) name
);