/***********************************************************************/ /* */ /* Objective Caml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* Automatique. Distributed only by permission. */ /* */ /***********************************************************************/ /* $Id$ */ #include #include #include "libgraph.h" #include #include #include #include #ifdef HAS_SETITIMER #include #endif Display * grdisplay = NULL; int grscreen; Colormap grcolormap; int grwhite, grblack; struct canvas grwindow; struct canvas grbstore; int grx, gry; unsigned long grcolor; extern XFontStruct * grfont; static Bool gr_initialized = False; static int gr_error_handler(Display *display, XErrorEvent *error); static int gr_ioerror_handler(Display *display); value gr_clear_graph(void); value gr_open_graph(value arg) { char display_name[64], geometry_spec[64]; char * p, * q; XSizeHints hints; int ret; XEvent event; int x, y, w, h; XWindowAttributes attributes; if (gr_initialized) { gr_clear_graph(); } else { /* Parse the argument */ for (p = String_val(arg), q = display_name; *p != 0 && *p != ' '; p++) if (q < display_name + sizeof(display_name) - 1) *q++ = *p; *q = 0; while (*p == ' ') p++; for (q = geometry_spec; *p != 0; p++) if (q < geometry_spec + sizeof(geometry_spec) - 1) *q++ = *p; *q = 0; /* Open the display */ if (grdisplay == NULL) { grdisplay = XOpenDisplay(display_name); if (grdisplay == NULL) gr_fail("Cannot open display %s", XDisplayName(display_name)); grscreen = DefaultScreen(grdisplay); grblack = BlackPixel(grdisplay, grscreen); grwhite = WhitePixel(grdisplay, grscreen); grcolormap = DefaultColormap(grdisplay, grscreen); } /* Set up the error handlers */ XSetErrorHandler(gr_error_handler); XSetIOErrorHandler(gr_ioerror_handler); /* Parse the geometry specification */ hints.x = 0; hints.y = 0; hints.width = DEFAULT_SCREEN_WIDTH; hints.height = DEFAULT_SCREEN_HEIGHT; hints.flags = PPosition | PSize; hints.win_gravity = 0; ret = XWMGeometry(grdisplay, grscreen, geometry_spec, "", BORDER_WIDTH, &hints, &x, &y, &w, &h, &hints.win_gravity); if (ret & (XValue | YValue)) { hints.x = x; hints.y = y; hints.flags |= USPosition; } if (ret & (WidthValue | HeightValue)) { hints.width = w; hints.height = h; hints.flags |= USSize; } /* Initial drawing color is black */ grcolor = grblack; /* Create the on-screen window */ grwindow.w = hints.width; grwindow.h = hints.height; grwindow.win = XCreateSimpleWindow(grdisplay, DefaultRootWindow(grdisplay), hints.x, hints.y, hints.width, hints.height, BORDER_WIDTH, grblack, grwhite); XSetStandardProperties(grdisplay, grwindow.win, WINDOW_NAME, ICON_NAME, None, NULL, 0, &hints); grwindow.gc = XCreateGC(grdisplay, grwindow.win, 0, NULL); XSetBackground(grdisplay, grwindow.gc, grwhite); XSetForeground(grdisplay, grwindow.gc, grcolor); /* Require exposure, resize and keyboard events */ XSelectInput(grdisplay, grwindow.win, DEFAULT_EVENT_MASK); /* Map the window on the screen and wait for the first Expose event */ XMapWindow(grdisplay, grwindow.win); do { XNextEvent(grdisplay, &event); } while (event.type != Expose); /* Get the actual window dimensions */ XGetWindowAttributes(grdisplay, grwindow.win, &attributes); grwindow.w = attributes.width; grwindow.h = attributes.height; /* Create the pixmap used for backing store */ grbstore.w = grwindow.w; grbstore.h = grwindow.h; grbstore.win = XCreatePixmap(grdisplay, grwindow.win, grbstore.w, grbstore.h, XDefaultDepth(grdisplay, grscreen)); grbstore.gc = XCreateGC(grdisplay, grbstore.win, 0, NULL); XSetBackground(grdisplay, grbstore.gc, grwhite); /* Clear the pixmap */ XSetForeground(grdisplay, grbstore.gc, grwhite); XFillRectangle(grdisplay, grbstore.win, grbstore.gc, 0, 0, grbstore.w, grbstore.h); XSetForeground(grdisplay, grbstore.gc, grcolor); /* The global data structures are now correctly initialized. In particular, gr_sigio_handler can now handle events safely. */ gr_initialized = True; /* If possible, request that system calls be restarted after the EVENT_SIGNAL signal. */ #ifdef POSIX_SIGNALS #ifdef SA_RESTART { struct sigaction action; sigaction(EVENT_SIGNAL, NULL, &action); action.sa_flags |= SA_RESTART; sigaction(EVENT_SIGNAL, &action, NULL); } #endif #endif #ifdef USE_ASYNC_IO /* If BSD-style asynchronous I/O are supported: arrange for I/O on the connection to trigger the SIGIO signal */ ret = fcntl(ConnectionNumber(grdisplay), F_GETFL, 0); fcntl(ConnectionNumber(grdisplay), F_SETFL, ret | FASYNC); fcntl(ConnectionNumber(grdisplay), F_SETOWN, getpid()); #endif } #ifdef USE_INTERVAL_TIMER /* If BSD-style interval timers are provided, use the real-time timer to poll events. */ { struct itimerval it; it.it_interval.tv_sec = 0; it.it_interval.tv_usec = 250000; it.it_value.tv_sec = 0; it.it_value.tv_usec = 250000; setitimer(ITIMER_REAL, &it, NULL); } #endif #ifdef USE_ALARM /* The poor man's solution: use alarm to poll events. */ alarm(1); #endif /* Position the current point at origin */ grx = 0; gry = 0; /* Reset the color cache */ gr_init_color_cache(); return Val_unit; } value gr_close_graph(void) { if (gr_initialized) { #ifdef USE_INTERVAL_TIMER struct itimerval it; it.it_value.tv_sec = 0; it.it_value.tv_usec = 0; setitimer(ITIMER_REAL, &it, NULL); #endif gr_initialized = False; if (grfont != NULL) { XFreeFont(grdisplay, grfont); grfont = NULL; } XFreeGC(grdisplay, grwindow.gc); XDestroyWindow(grdisplay, grwindow.win); XFreeGC(grdisplay, grbstore.gc); XFreePixmap(grdisplay, grbstore.win); XFlush(grdisplay); } return Val_unit; } value gr_clear_graph(void) { gr_check_open(); XSetForeground(grdisplay, grwindow.gc, grwhite); XFillRectangle(grdisplay, grwindow.win, grwindow.gc, 0, 0, grwindow.w, grwindow.h); XSetForeground(grdisplay, grwindow.gc, grcolor); XSetForeground(grdisplay, grbstore.gc, grwhite); XFillRectangle(grdisplay, grbstore.win, grbstore.gc, 0, 0, grbstore.w, grbstore.h); XSetForeground(grdisplay, grbstore.gc, grcolor); XFlush(grdisplay); gr_init_color_cache(); return Val_unit; } value gr_size_x(void) { gr_check_open(); return Val_int(grwindow.w); } value gr_size_y(void) { gr_check_open(); return Val_int(grwindow.h); } /* The gr_sigio_handler is called via the signal machinery in the bytecode interpreter. The signal system ensures that this function will be called either between two bytecode instructions, or during a blocking primitive. In either case, not in the middle of an Xlib call. (There is no blocking primitives in this library, not even wait_next_event, for various reasons.) */ void gr_handle_simple_event(XEvent *e); value gr_sigio_signal(value unit) { return Val_int(EVENT_SIGNAL); } value gr_sigio_handler(void) { XEvent grevent; if (gr_initialized) { while (XCheckMaskEvent(grdisplay, -1 /*all events*/, &grevent)) gr_handle_simple_event(&grevent); } #ifdef USE_ALARM alarm(1); #endif return Val_unit; } void gr_handle_simple_event(XEvent *e) { switch (e->type) { case Expose: XCopyArea(grdisplay, grbstore.win, grwindow.win, grwindow.gc, e->xexpose.x, e->xexpose.y + grbstore.h - grwindow.h, e->xexpose.width, e->xexpose.height, e->xexpose.x, e->xexpose.y); XFlush(grdisplay); break; case ConfigureNotify: grwindow.w = e->xconfigure.width; grwindow.h = e->xconfigure.height; if (grwindow.w > grbstore.w || grwindow.h > grbstore.h) { /* Allocate a new backing store large enough to accomodate both the old backing store and the current window. */ struct canvas newbstore; newbstore.w = max(grwindow.w, grbstore.w); newbstore.h = max(grwindow.h, grbstore.h); newbstore.win = XCreatePixmap(grdisplay, grwindow.win, newbstore.w, newbstore.h, XDefaultDepth(grdisplay, grscreen)); newbstore.gc = XCreateGC(grdisplay, newbstore.win, 0, NULL); XSetBackground(grdisplay, newbstore.gc, grwhite); XSetForeground(grdisplay, newbstore.gc, grwhite); XFillRectangle(grdisplay, newbstore.win, newbstore.gc, 0, 0, newbstore.w, newbstore.h); XSetForeground(grdisplay, newbstore.gc, grcolor); /* Copy the old backing store into the new one */ XCopyArea(grdisplay, grbstore.win, newbstore.win, newbstore.gc, 0, 0, grbstore.w, grbstore.h, 0, newbstore.h - grbstore.h); /* Free the old backing store */ XFreeGC(grdisplay, grbstore.gc); XFreePixmap(grdisplay, grbstore.win); /* Use the new backing store */ grbstore = newbstore; XFlush(grdisplay); } break; case MappingNotify: XRefreshKeyboardMapping(&(e->xmapping)); break; case KeyPress: { KeySym thekey; char keytxt[256]; int nchars; char * p; nchars = XLookupString(&(e->xkey), keytxt, sizeof(keytxt), &thekey, 0); for (p = keytxt; nchars > 0; p++, nchars--) gr_enqueue_char(*p); break; } } } /* Processing of graphic errors */ static value * graphic_failure_exn = NULL; void gr_fail(char *fmt, char *arg) { char buffer[1024]; if (graphic_failure_exn == NULL) { graphic_failure_exn = caml_named_value("Graphics.Graphic_failure"); if (graphic_failure_exn == NULL) invalid_argument("Exception Graphics.Graphic_failure not initialized, must link graphics.cma"); } sprintf(buffer, fmt, arg); raise_with_string(*graphic_failure_exn, buffer); } void gr_check_open(void) { if (!gr_initialized) gr_fail("graphic screen not opened", NULL); } static int gr_error_handler(Display *display, XErrorEvent *error) { char errmsg[512]; XGetErrorText(error->display, error->error_code, errmsg, sizeof(errmsg)); gr_fail("Xlib error: %s", errmsg); return 0; } static int gr_ioerror_handler(Display *display) { gr_fail("fatal I/O error", NULL); return 0; }