ocaml/otherlibs/graph/open.c

359 lines
11 KiB
C

/***********************************************************************/
/* */
/* Objective Caml */
/* */
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
/* */
/* Copyright 1996 Institut National de Recherche en Informatique et */
/* Automatique. Distributed only by permission. */
/* */
/***********************************************************************/
/* $Id$ */
#include <fcntl.h>
#include <signal.h>
#include "libgraph.h"
#include <alloc.h>
#include <callback.h>
#include <fail.h>
#include <memory.h>
#ifdef HAS_SETITIMER
#include <sys/time.h>
#endif
Display * grdisplay = NULL;
static Bool gr_initialized = False;
static int gr_error_handler();
static int gr_ioerror_handler();
value gr_clear_graph();
value gr_open_graph(arg)
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()
{
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()
{
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);
return Val_unit;
}
value gr_size_x()
{
gr_check_open();
return Val_int(grwindow.w);
}
value gr_size_y()
{
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();
value gr_sigio_signal(unit)
value unit;
{
return Val_int(EVENT_SIGNAL);
}
value gr_sigio_handler()
{
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(e)
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(fmt, arg)
char * fmt, * 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()
{
if (!gr_initialized) gr_fail("graphic screen not opened", NULL);
}
static int gr_error_handler(display, error)
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 * display;
{
gr_fail("fatal I/O error", NULL);
return 0;
}