value caml_gr_wait_event_r(CAML_R, value eventlist) /* ML */
{
int mask;
Bool poll;
caml_gr_check_open();
mask = 0;
poll = False;
while (eventlist != Val_int(0)) {
switch (Int_val(Field(eventlist, 0))) {
case 0: /* Button_down */
mask |= ButtonPressMask | OwnerGrabButtonMask; break;
case 1: /* Button_up */
mask |= ButtonReleaseMask | OwnerGrabButtonMask; break;
case 2: /* Key_pressed */
mask |= KeyPressMask; break;
case 3: /* Mouse_motion */
mask |= PointerMotionMask; break;
case 4: /* Poll */
poll = True; break;
}
eventlist = Field(eventlist, 1);
}
if (poll)
return caml_gr_wait_event_poll_r(ctx);
else
return caml_gr_wait_event_blocking_r(ctx, mask);
}
value caml_gr_draw_char(value chr)
{
char str[1];
caml_gr_check_open();
str[0] = Int_val(chr);
caml_gr_draw_text(str, 1);
return Val_unit;
}
value caml_gr_close_subwindow(value wid)
{
Window win;
caml_gr_check_open();
sscanf( String_val(wid), "%lu", (unsigned long *)(&win) );
XDestroyWindow(caml_gr_display, win);
XFlush(caml_gr_display);
return Val_unit;
}
value caml_gr_synchronize(void)
{
caml_gr_check_open();
XCopyArea(caml_gr_display, caml_gr_bstore.win, caml_gr_window.win, caml_gr_window.gc,
0, caml_gr_bstore.h - caml_gr_window.h,
caml_gr_window.w, caml_gr_window.h,
0, 0);
XFlush(caml_gr_display);
return Val_unit ;
}
value caml_gr_set_line_width(value vwidth)
{
int width = Int_val(vwidth);
caml_gr_check_open();
XSetLineAttributes(caml_gr_display, caml_gr_window.gc,
width, LineSolid, CapRound, JoinRound);
XSetLineAttributes(caml_gr_display, caml_gr_bstore.gc,
width, LineSolid, CapRound, JoinRound);
return Val_unit;
}
value caml_gr_blit_image(value im, value vx, value vy)
{
int x = Int_val(vx);
int y = Int_val(vy);
caml_gr_check_open();
XCopyArea(caml_gr_display, caml_gr_bstore.win, Data_im(im), caml_gr_bstore.gc,
x, Bcvt(y) + 1 - Height_im(im),
Width_im(im), Height_im(im),
0, 0);
return Val_unit;
}
value caml_gr_text_size(value str)
{
CAMLparam1(str);
CAMLlocal1(res);
int width;
caml_gr_check_open();
if (caml_gr_font == NULL) caml_gr_get_font(DEFAULT_FONT);
width = XTextWidth(caml_gr_font, String_val(str), caml_string_length(str));
res = caml_alloc_2(0, Val_int(width),
Val_int(caml_gr_font->ascent + caml_gr_font->descent));
CAMLreturn(res);
}
value caml_gr_text_size(value str)
{
int width;
value res;
caml_gr_check_open();
if (caml_gr_font == NULL) caml_gr_get_font(DEFAULT_FONT);
width = XTextWidth(caml_gr_font, String_val(str), string_length(str));
res = alloc_small(2, 0);
Field(res, 0) = Val_int(width);
Field(res, 1) = Val_int(caml_gr_font->ascent + caml_gr_font->descent);
return res;
}
value caml_gr_plot(value vx, value vy)
{
int x = Int_val(vx);
int y = Int_val(vy);
caml_gr_check_open();
if(caml_gr_remember_modeflag)
XDrawPoint(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc, x,
Bcvt(y));
if(caml_gr_display_modeflag) {
XDrawPoint(caml_gr_display, caml_gr_window.win, caml_gr_window.gc, x,
Wcvt(y));
XFlush(caml_gr_display);
}
return Val_unit;
}
value caml_gr_lineto(value vx, value vy)
{
int x = Int_val(vx);
int y = Int_val(vy);
caml_gr_check_open();
if(caml_gr_remember_modeflag)
XDrawLine(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc,
caml_gr_x, Bcvt(caml_gr_y), x, Bcvt(y));
if(caml_gr_display_modeflag) {
XDrawLine(caml_gr_display, caml_gr_window.win, caml_gr_window.gc,
caml_gr_x, Wcvt(caml_gr_y), x, Wcvt(y));
XFlush(caml_gr_display);
}
caml_gr_x = x;
caml_gr_y = y;
return Val_unit;
}
value caml_gr_sound(value vfreq, value vdur)
{
XKeyboardControl kbdcontrol;
caml_gr_check_open();
kbdcontrol.bell_pitch = Int_val(vfreq);
kbdcontrol.bell_duration = Int_val(vdur);
XChangeKeyboardControl(caml_gr_display, KBBellPitch | KBBellDuration,
&kbdcontrol);
XBell(caml_gr_display, 0);
kbdcontrol.bell_pitch = -1; /* restore default value */
kbdcontrol.bell_duration = -1; /* restore default value */
XChangeKeyboardControl(caml_gr_display, KBBellPitch | KBBellDuration,
&kbdcontrol);
XFlush(caml_gr_display);
return Val_unit;
}
value caml_gr_open_subwindow(value vx, value vy, value width, value height)
{
Window win;
int h = Int_val(height);
int w = Int_val(width);
int x = Int_val(vx);
int y = Int_val(vy);
caml_gr_check_open();
win = XCreateSimpleWindow(caml_gr_display, caml_gr_window.win,
x, Wcvt(y + h), w, h,
0, caml_gr_black, caml_gr_background);
XMapWindow(caml_gr_display, win);
XFlush(caml_gr_display);
return (caml_gr_id_of_window (win));
}
value caml_gr_draw_rect(value vx, value vy, value vw, value vh)
{
int x = Int_val(vx);
int y = Int_val(vy);
int w = Int_val(vw);
int h = Int_val(vh);
caml_gr_check_open();
if(caml_gr_remember_modeflag)
XDrawRectangle(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc,
x, Bcvt(y) - h, w, h);
if(caml_gr_display_modeflag) {
XDrawRectangle(caml_gr_display, caml_gr_window.win, caml_gr_window.gc,
x, Wcvt(y) - h, w, h);
XFlush(caml_gr_display);
}
return Val_unit;
}
value caml_gr_clear_graph(void)
{
caml_gr_check_open();
if(caml_gr_remember_modeflag) {
XSetForeground(caml_gr_display, caml_gr_bstore.gc, caml_gr_white);
XFillRectangle(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc,
0, 0, caml_gr_bstore.w, caml_gr_bstore.h);
XSetForeground(caml_gr_display, caml_gr_bstore.gc, caml_gr_color);
}
if(caml_gr_display_modeflag) {
XSetForeground(caml_gr_display, caml_gr_window.gc, caml_gr_white);
XFillRectangle(caml_gr_display, caml_gr_window.win, caml_gr_window.gc,
0, 0, caml_gr_window.w, caml_gr_window.h);
XSetForeground(caml_gr_display, caml_gr_window.gc, caml_gr_color);
XFlush(caml_gr_display);
}
caml_gr_init_color_cache();
caml_gr_init_direct_rgb_to_pixel();
return Val_unit;
}
value caml_gr_draw_arc_nat(value vx, value vy, value vrx, value vry, value va1,
value va2)
{
int x = Int_val(vx);
int y = Int_val(vy);
int rx = Int_val(vrx);
int ry = Int_val(vry);
int a1 = Int_val(va1);
int a2 = Int_val(va2);
caml_gr_check_open();
if(caml_gr_remember_modeflag)
XDrawArc(caml_gr_display, caml_gr_bstore.win, caml_gr_bstore.gc,
x - rx, Bcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64);
if(caml_gr_display_modeflag) {
XDrawArc(caml_gr_display, caml_gr_window.win, caml_gr_window.gc,
x - rx, Wcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64);
XFlush(caml_gr_display);
}
return Val_unit;
}
static value caml_gr_wait_event_blocking_r(CAML_R, long mask)
{
XEvent event;
fd_set readfds;
value res;
/* First see if we have a matching event in the queue */
res = caml_gr_wait_event_in_queue_r(ctx, mask);
if (res != Val_false) return res;
/* Increase the selected events if required */
if ((mask & ~caml_gr_selected_events) != 0) {
caml_gr_selected_events |= mask;
XSelectInput(caml_gr_display, caml_gr_window.win, caml_gr_selected_events);
}
/* Replenish our event queue from that of X11 */
caml_gr_ignore_sigio = True;
while (1) {
if (XCheckMaskEvent(caml_gr_display, -1 /*all events*/, &event)) {
/* One event available: add it to our queue */
caml_gr_handle_event(&event);
/* See if we now have a matching event */
res = caml_gr_wait_event_in_queue_r(ctx, mask);
if (res != Val_false) break;
} else {
/* No event available: block on input socket until one is */
FD_ZERO(&readfds);
FD_SET(ConnectionNumber(caml_gr_display), &readfds);
caml_enter_blocking_section_r(ctx);
select(FD_SETSIZE, &readfds, NULL, NULL, NULL);
caml_leave_blocking_section_r(ctx);
caml_gr_check_open(); /* in case another thread closed the display */
}
}
caml_gr_ignore_sigio = False;
/* Return result */
return res;
}
value caml_gr_draw_image(value im, value vx, value vy)
{
int x = Int_val(vx);
int y = Int_val(vy);
int wy = Wcvt(y) + 1 - Height_im(im);
int by = Bcvt(y) + 1 - Height_im(im);
caml_gr_check_open();
if (Mask_im(im) != None) {
if(caml_gr_remember_modeflag) {
XSetClipOrigin(caml_gr_display, caml_gr_bstore.gc, x, by);
XSetClipMask(caml_gr_display, caml_gr_bstore.gc, Mask_im(im));
}
if(caml_gr_display_modeflag) {
XSetClipOrigin(caml_gr_display, caml_gr_window.gc, x, wy);
XSetClipMask(caml_gr_display, caml_gr_window.gc, Mask_im(im));
}
}
if(caml_gr_remember_modeflag)
XCopyArea(caml_gr_display, Data_im(im), caml_gr_bstore.win, caml_gr_bstore.gc,
0, 0,
Width_im(im), Height_im(im),
x, by);
if(caml_gr_display_modeflag)
XCopyArea(caml_gr_display, Data_im(im), caml_gr_window.win, caml_gr_window.gc,
0, 0,
Width_im(im), Height_im(im),
x, wy);
if (Mask_im(im) != None) {
if(caml_gr_remember_modeflag)
XSetClipMask(caml_gr_display, caml_gr_bstore.gc, None);
if(caml_gr_display_modeflag)
XSetClipMask(caml_gr_display, caml_gr_window.gc, None);
}
if(caml_gr_display_modeflag)
XFlush(caml_gr_display);
return Val_unit;
}
value caml_gr_resize_window (value vx, value vy)
{
caml_gr_check_open ();
caml_gr_window.w = Int_val (vx);
caml_gr_window.h = Int_val (vy);
XResizeWindow (caml_gr_display, caml_gr_window.win, caml_gr_window.w,
caml_gr_window.h);
XFreeGC(caml_gr_display, caml_gr_bstore.gc);
XFreePixmap(caml_gr_display, caml_gr_bstore.win);
caml_gr_bstore.w = caml_gr_window.w;
caml_gr_bstore.h = caml_gr_window.h;
caml_gr_bstore.win =
XCreatePixmap(caml_gr_display, caml_gr_window.win, caml_gr_bstore.w,
caml_gr_bstore.h,
XDefaultDepth(caml_gr_display, caml_gr_screen));
caml_gr_bstore.gc = XCreateGC(caml_gr_display, caml_gr_bstore.win, 0, NULL);
XSetBackground(caml_gr_display, caml_gr_bstore.gc, caml_gr_background);
caml_gr_clear_graph ();
return Val_unit;
}
value caml_gr_window_id(void)
{
caml_gr_check_open();
return caml_gr_id_of_window(caml_gr_window.win);
}
value caml_gr_draw_string(value str)
{
caml_gr_check_open();
caml_gr_draw_text(String_val(str), string_length(str));
return Val_unit;
}
value caml_gr_size_y(void)
{
caml_gr_check_open();
return Val_int(caml_gr_window.h);
}
value caml_gr_set_font(value fontname)
{
caml_gr_check_open();
caml_gr_get_font(String_val(fontname));
return Val_unit;
}
value caml_gr_create_image(value vw, value vh)
{
caml_gr_check_open();
return caml_gr_new_image(Int_val(vw), Int_val(vh));
}
value caml_gr_dump_image(value image)
{
int width, height, i, j;
XImage * idata, * imask;
value m = Val_unit;
Begin_roots2(image, m);
caml_gr_check_open();
width = Width_im(image);
height = Height_im(image);
m = alloc(height, 0);
for (i = 0; i < height; i++) {
value v = alloc(width, 0);
modify(&Field(m, i), v);
}
idata =
XGetImage(caml_gr_display, Data_im(image), 0, 0, width, height, (-1), ZPixmap);
for (i = 0; i < height; i++)
for (j = 0; j < width; j++)
Field(Field(m, i), j) = Val_int(caml_gr_rgb_pixel(XGetPixel(idata, j, i)));
XDestroyImage(idata);
if (Mask_im(image) != None) {
imask =
XGetImage(caml_gr_display, Mask_im(image), 0, 0, width, height, 1, ZPixmap);
for (i = 0; i < height; i++)
for (j = 0; j < width; j++)
if (XGetPixel(imask, j, i) == 0)
Field(Field(m, i), j) = Val_int(Transparent);
XDestroyImage(imask);
}
End_roots();
return m;
}
