Recuperation de libgraph de CL0.7

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
author: Xavier Leroy <xavier.leroy@inria.fr> 1995-05-08 17:04:35 +0000
committer: Xavier Leroy <xavier.leroy@inria.fr> 1995-05-08 17:04:35 +0000
commit: e22a62afc8cb34a5a491b9da3a777e42d95f351d (patch)
tree: 916924829b31dc561121fec288b042e6dfe81aa6 /otherlibs/graph
parent: 3844ccfcf176f5d3efd9df040f9134402b8f4d76 (diff)
16 files changed, 1457 insertions, 0 deletions
diff --git a/otherlibs/graph/Makefile b/otherlibs/graph/Makefile
new file mode 100644
index 000000000..f9ab18633
--- /dev/null
+++ b/otherlibs/graph/Makefile
@@ -0,0 +1,41 @@
+# Makefile for the portable graphics library
+
+include ../../Makefile.config
+
+CFLAGS=$(CCCOMPOPTS) -I../../byterun -O
+
+CAMLC=../../boot/camlrun ../../boot/camlc -I ../../boot
+
+OBJS=open.o draw.o fill.o color.o text.o \
+  image.o make_img.o dump_img.o point_col.o sound.o events.o
+
+all: libgraph.a graphics.cmi graphics.cma
+
+libgraph.a: $(OBJS)
+	rm -f libgraph.a
+	ar rc libgraph.a $(OBJS)
+	$(RANLIB) libgraph.a
+
+graphics.cma: graphics.cmo
+	$(CAMLC) -a -o graphics.cma graphics.cmo
+
+clean::
+	rm -f libgraph.a $(GENFILES) *.o *.cm[ioa]
+
+install:
+	cp libgraph.a $(LIBDIR)/libgraph.a
+	cd $(LIBDIR); $(RANLIB) libgraph.a
+	cp graphics.cm[ia] $(LIBDIR)
+
+.SUFFIXES: .ml .mli .cmo .cmi
+
+.mli.cmi:
+	$(CAMLC) -c $<
+.ml.cmo:
+	$(CAMLC) -c $<
+
+depend:
+	gcc -MM $(CFLAGS) *.c > .depend
+	../../tools/camldep *.mli *.ml >> .depend
+
+include .depend
diff --git a/otherlibs/graph/color.c b/otherlibs/graph/color.c
new file mode 100644
index 000000000..22ffc2925
--- /dev/null
+++ b/otherlibs/graph/color.c
@@ -0,0 +1,89 @@
+#include "libgraph.h"
+
+/* Cache to speed up the translation rgb -> pixel value. */
+
+struct color_cache_entry {
+  int rgb;                      /* RGB value with format 0xRRGGBB */
+  unsigned long pixel;          /* Pixel value */
+};
+
+#define Color_cache_size 64
+static struct color_cache_entry color_cache[Color_cache_size];
+#define Empty (-1)
+#define Hash_rgb(r,g,b) \
+  ((((r) & 0xC0) >> 2) + (((g) & 0xC0) >> 4) + (((b) & 0xC0) >> 6))
+
+void gr_init_color_cache()
+{
+  int i;
+  for (i = 0; i < Color_cache_size; i++) color_cache[i].rgb = Empty;
+  i = Hash_rgb(0, 0, 0);
+  color_cache[i].rgb = 0;
+  color_cache[i].pixel = grblack;
+  i = Hash_rgb(0xFF, 0xFF, 0xFF);
+  color_cache[i].rgb = 0xFFFFFF;
+  color_cache[i].pixel = grwhite;
+}
+
+unsigned long gr_pixel_rgb(rgb)
+     int rgb;
+
+{
+  unsigned int r, g, b;
+  int h, i;
+  XColor color;
+
+  r = (rgb >> 16) & 0xFF;
+  g = (rgb >> 8) & 0xFF;
+  b = rgb & 0xFF;
+  h = Hash_rgb(r, g, b);
+  i = h;
+  while(1) {
+    if (color_cache[i].rgb == Empty) break;
+    if (color_cache[i].rgb == rgb) return color_cache[i].pixel;
+    i = (i + 1) & (Color_cache_size - 1);
+    if (i == h) break;
+  }
+  color.red = r * 0x101;
+  color.green = g * 0x101;
+  color.blue = b * 0x101;
+  XAllocColor(grdisplay, grcolormap, &color);
+  color_cache[i].rgb = rgb;
+  color_cache[i].pixel = color.pixel;
+  return color.pixel;
+}
+
+int gr_rgb_pixel(pixel)
+     unsigned long pixel;
+{
+  XColor color;
+  int i;
+
+  if (pixel == grblack) return 0;
+  if (pixel == grwhite) return 0xFFFFFF;
+
+  /* Probably faster to do a linear search than to query the X server. */
+  for (i = 0; i < Color_cache_size; i++) {
+    if (color_cache[i].rgb != Empty && color_cache[i].pixel == pixel)
+      return color_cache[i].rgb;
+  }
+  color.pixel = pixel;
+  XQueryColor(grdisplay, grcolormap, &color);
+  return
+    ((color.red >> 8) << 16) + ((color.green >> 8) << 8) + (color.blue >> 8);
+}
+
+value gr_set_color(vrgb)
+     value vrgb;
+{
+  gr_check_open();
+  grcolor = gr_pixel_rgb(Int_val(vrgb));
+  XSetForeground(grdisplay, grwindow.gc, grcolor);
+  XSetForeground(grdisplay, grbstore.gc, grcolor);
+  return Val_unit;
+}
+
+
+                                     
+
+
diff --git a/otherlibs/graph/draw.c b/otherlibs/graph/draw.c
new file mode 100644
index 000000000..8f41b5988
--- /dev/null
+++ b/otherlibs/graph/draw.c
@@ -0,0 +1,75 @@
+#include "libgraph.h"
+#include <alloc.h>
+
+value gr_plot(vx, vy)
+     value vx, vy;
+{
+  int x = Int_val(vx);
+  int y = Int_val(vy);
+  XDrawPoint(grdisplay, grwindow.win, grwindow.gc, x, Wcvt(y));
+  XDrawPoint(grdisplay, grbstore.win, grbstore.gc, x, Bcvt(y));
+  XFlush(grdisplay);
+  return Val_unit;
+}
+
+value gr_moveto(vx, vy)
+     value vx, vy;
+{
+  grx = Int_val(vx);
+  gry = Int_val(vy);
+  return Val_unit;
+}
+
+value gr_current_point()
+{
+  value res;
+  res = alloc_tuple(2);
+  Field(res, 0) = Val_int(grx);
+  Field(res, 1) = Val_int(gry);
+  return res;
+}
+
+value gr_lineto(vx, vy)
+     value vx, vy;
+{
+  int x = Int_val(vx);
+  int y = Int_val(vy);
+  XDrawLine(grdisplay, grwindow.win, grwindow.gc,
+            grx, Wcvt(gry), x, Wcvt(y));
+  XDrawLine(grdisplay, grbstore.win, grbstore.gc,
+            grx, Bcvt(gry), x, Bcvt(y));
+  grx = x;
+  gry = y;
+  XFlush(grdisplay);
+  return Val_unit;
+}
+
+value gr_draw_arc(argv, argc)
+     int argc;
+     value * argv;
+{
+  int x = Int_val(argv[0]);
+  int y = Int_val(argv[1]);
+  int rx = Int_val(argv[2]);
+  int ry = Int_val(argv[3]);
+  int a1 = Int_val(argv[4]);
+  int a2 = Int_val(argv[5]);
+  XDrawArc(grdisplay, grwindow.win, grwindow.gc,
+           x - rx, Wcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64);
+  XDrawArc(grdisplay, grbstore.win, grbstore.gc,
+           x - rx, Bcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64);
+  XFlush(grdisplay);
+  return Val_unit;
+}
+
+value gr_set_line_width(vwidth)
+     value vwidth;
+{
+  int width = Int_val(vwidth);
+  XSetLineAttributes(grdisplay, grwindow.gc,
+                     width, LineSolid, CapRound, JoinRound);
+  XSetLineAttributes(grdisplay, grbstore.gc,
+                     width, LineSolid, CapRound, JoinRound);
+  return Val_unit;
+}
+
diff --git a/otherlibs/graph/dump_img.c b/otherlibs/graph/dump_img.c
new file mode 100644
index 000000000..1578acb36
--- /dev/null
+++ b/otherlibs/graph/dump_img.c
@@ -0,0 +1,66 @@
+#include "libgraph.h"
+#include "image.h"
+#include <memory.h>
+
+static value gr_alloc_int_vect(size)
+     mlsize_t size;
+{
+  value res;
+  mlsize_t i;
+  
+  if (size <= Max_young_wosize) {
+    res = alloc(size, 0);
+  } else {
+    res = alloc_shr(size, 0);
+  }
+  for (i = 0; i < size; i++) {
+    Field(res, i) = Val_long(0);
+  }
+  return res;
+}
+
+value gr_dump_image(image)
+     value image;
+{
+  int width, height, i, j;
+  XImage * idata, * imask;
+  Push_roots(root, 2);
+
+#define im root[0]
+#define m root[1]
+
+  gr_check_open();
+  im = image;
+  width = Width_im(im);
+  height = Height_im(im);
+  m = gr_alloc_int_vect(height);
+  for (i = 0; i < height; i++) {
+    value v = gr_alloc_int_vect(width);
+    modify(&Field(m, i), v);
+  }
+  
+  idata =
+    XGetImage(grdisplay, Data_im(im), 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(gr_rgb_pixel(XGetPixel(idata, j, i)));
+  XDestroyImage(idata);
+
+  if (Mask_im(im) != None) {
+    imask =
+      XGetImage(grdisplay, Mask_im(im), 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);
+  }
+  Pop_roots();
+  return m;
+
+#undef im
+#undef m
+}
+
+
+    
diff --git a/otherlibs/graph/events.c b/otherlibs/graph/events.c
new file mode 100644
index 000000000..78f061839
--- /dev/null
+++ b/otherlibs/graph/events.c
@@ -0,0 +1,114 @@
+#include <signal.h>
+#include "libgraph.h"
+#include <alloc.h>
+
+static unsigned char gr_queue[SIZE_QUEUE];
+static int gr_head = 0;       /* position of next read */
+static int gr_tail = 0;       /* position of next write */
+
+#define QueueIsEmpty (gr_head == gr_tail)
+#define QueueIsFull  (gr_head == gr_tail + 1)
+
+void gr_enqueue_char(c)
+     unsigned char c;
+{
+  if (QueueIsFull) return;
+  gr_queue[gr_tail] = c;
+  gr_tail++;
+  if (gr_tail >= SIZE_QUEUE) gr_tail = 0;
+}
+
+value gr_wait_event(eventlist)
+     value eventlist;
+{
+  value res;
+  int mask;
+  Bool poll;
+  int mouse_x, mouse_y, button, key;
+  Window rootwin, childwin;
+  int root_x, root_y, win_x, win_y;
+  unsigned int modifiers;
+  void (*oldsig)();
+  XEvent event;
+
+  mask = 0;
+  poll = False;
+  while (Tag_val(eventlist) == 1) {
+    switch (Tag_val(Field(eventlist, 0))) {
+    case 0:                     /* Button_down */
+      mask |= ButtonPressMask; break;
+    case 1:                     /* Button_up */
+      mask |= ButtonReleaseMask; 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);
+  }
+  mouse_x = -1;
+  mouse_y = -1;
+  button = 0;
+  key = 0x100;
+
+  if (poll) {
+    if (XQueryPointer(grdisplay, grwindow.win,
+                      &rootwin, &childwin,
+                      &root_x, &root_y, &win_x, &win_y,
+                      &modifiers)) {
+      mouse_x = win_x;
+      mouse_y = win_y;
+    }
+    button = modifiers & Button1Mask;
+    if (!QueueIsEmpty) key = gr_queue[gr_head];
+  } else {
+    if ((mask & KeyPressMask) && !QueueIsEmpty) {
+      key = gr_queue[gr_head];
+      gr_head++;
+      if (gr_head >= SIZE_QUEUE) gr_head = 0;
+    } else {
+      oldsig = signal(EVENT_SIGNAL, SIG_IGN);
+      XSelectInput(grdisplay, grwindow.win, DEFAULT_EVENT_MASK | mask);
+    again:
+      XNextEvent(grdisplay, &event);
+      switch(event.type) {
+      case ButtonPress:
+      case ButtonRelease:
+        mouse_x = event.xbutton.x;
+        mouse_y = event.xbutton.y;
+        button = event.type == ButtonPress;
+        break;
+      case MotionNotify:
+        mouse_x = event.xmotion.x;
+        mouse_y = event.xmotion.y;
+        button = event.xmotion.state & Button1Mask;
+        break;
+      case KeyPress:
+        gr_handle_simple_event(&event);
+        /* Some KeyPress events do not enqueue any characters (e.g. pressing
+           Ctrl), because they expand via XLookupString to the empty string.
+           Therefore we need to check again whether the char queue is empty. */
+        if ((mask & KeyPressMask) == 0 || QueueIsEmpty) goto again;
+        key = gr_queue[gr_head];
+        gr_head++;
+        if (gr_head >= SIZE_QUEUE) gr_head = 0;
+        break;
+      default:
+        gr_handle_simple_event(&event);
+        goto again;
+      }
+      signal(EVENT_SIGNAL, oldsig);
+      XSelectInput(grdisplay, grwindow.win, DEFAULT_EVENT_MASK);
+      XFlush(grdisplay);
+    }
+  }
+  res = alloc_tuple(5);
+  Field(res, 0) = Val_int(mouse_x);
+  Field(res, 1) = Val_int(mouse_y == -1 ? -1 : Wcvt(mouse_y));
+  Field(res, 2) = Val_bool(button);
+  Field(res, 3) = Val_bool(key != 0x100);
+  Field(res, 4) = Val_int(key & 0xFF);
+  return res;
+}
diff --git a/otherlibs/graph/fill.c b/otherlibs/graph/fill.c
new file mode 100644
index 000000000..66e728553
--- /dev/null
+++ b/otherlibs/graph/fill.c
@@ -0,0 +1,61 @@
+#include "libgraph.h"
+#include <memory.h>
+
+value gr_fill_rect(vx, vy, vw, vh)
+     value vx, vy, vw, vh;
+{
+  int x = Int_val(vx);
+  int y = Int_val(vy);
+  int w = Int_val(vw);
+  int h = Int_val(vh);
+
+  XFillRectangle(grdisplay, grwindow.win, grwindow.gc,
+                 x, Wcvt(y) - h + 1, w, h);
+  XFillRectangle(grdisplay, grbstore.win, grbstore.gc,
+                 x, Bcvt(y) - h + 1, w, h);
+  XFlush(grdisplay);
+  return Val_unit;
+}
+
+value gr_fill_poly(array)
+     value array;
+{
+  XPoint * points;
+  int npoints, i;
+
+  npoints = Wosize_val(array);
+  points = (XPoint *) stat_alloc(npoints * sizeof(XPoint));
+  for (i = 0; i < npoints; i++) {
+    points[i].x = Int_val(Field(Field(array, i), 0));
+    points[i].y = Wcvt(Int_val(Field(Field(array, i), 1)));
+  }
+  XFillPolygon(grdisplay, grwindow.win, grwindow.gc, points,
+               npoints, Complex, CoordModeOrigin);
+  for (i = 0; i < npoints; i++) {
+    points[i].y = WtoB(points[i].y);
+  }
+  XFillPolygon(grdisplay, grbstore.win, grbstore.gc, points,
+               npoints, Complex, CoordModeOrigin);
+  XFlush(grdisplay);
+  stat_free((char *) points);
+  return Val_unit;
+}
+
+value gr_fill_arc(argv, argc)
+     int argc;
+     value * argv;
+{
+  int x = Int_val(argv[0]);
+  int y = Int_val(argv[1]);
+  int rx = Int_val(argv[2]);
+  int ry = Int_val(argv[3]);
+  int a1 = Int_val(argv[4]);
+  int a2 = Int_val(argv[5]);
+  XFillArc(grdisplay, grwindow.win, grwindow.gc,
+           x - rx, Wcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64);
+  XFillArc(grdisplay, grbstore.win, grbstore.gc,
+           x - rx, Bcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64);
+  XFlush(grdisplay);
+  return Val_unit;
+}
+
diff --git a/otherlibs/graph/graphics.ml b/otherlibs/graph/graphics.ml
new file mode 100644
index 000000000..c9e5f1551
--- /dev/null
+++ b/otherlibs/graph/graphics.ml
@@ -0,0 +1,122 @@
+exception Graphic_failure of string
+
+(* Initializations *)
+
+external raw_open_graph: string -> unit = "gr_open_graph"
+external raw_close_graph: unit -> unit = "gr_close_graph"
+external sigio_signal: unit -> int = "gr_sigio_signal"
+external sigio_handler: int -> unit = "gr_sigio_handler"
+external register_graphic_failure: exn -> unit = "gr_register_graphic_failure"
+
+let _ = register_graphic_failure(Graphic_failure "")
+
+let open_graph arg =
+  Sys.signal (sigio_signal()) (Sys.Signal_handle sigio_handler);
+  raw_open_graph arg
+
+let close_graph () =
+  Sys.signal (sigio_signal()) Sys.Signal_ignore;
+  raw_close_graph () 
+
+external clear_graph : unit -> unit = "gr_clear_graph"
+external size_x : unit -> int = "gr_size_x"
+external size_y : unit -> int = "gr_size_y"
+
+(* Colors *)
+
+type color = int
+
+let rgb r g b = (r lsl 16) + (g lsl 8) + b
+
+external set_color : color -> unit = "gr_set_color"
+
+let black   = 0x000000
+and white   = 0xFFFFFF
+and red     = 0xFF0000
+and green   = 0x00FF00
+and blue    = 0x0000FF
+and yellow  = 0xFFFF00
+and cyan    = 0x00FFFF
+and magenta = 0xFF00FF
+
+let background = white
+and foreground = black
+
+(* Drawing *)
+
+external plot : int -> int -> unit = "gr_plot"
+external point_color : int -> int -> color = "gr_point_color"
+external moveto : int -> int -> unit = "gr_moveto"
+external current_point : unit -> int * int = "gr_current_point"
+external lineto : int -> int -> unit = "gr_lineto"
+external draw_arc : int -> int -> int -> int -> int -> int -> unit
+               = "gr_draw_arc"
+let draw_ellipse x y rx ry = draw_arc x y rx ry 0 360
+let draw_circle x y r = draw_arc x y r r 0 360
+external set_line_width : int -> unit = "gr_set_line_width"
+
+external fill_rect : int -> int -> int -> int -> unit = "gr_fill_rect"
+external fill_poly : (int * int) array -> unit = "gr_fill_poly"
+external fill_arc : int -> int -> int -> int -> int -> int -> unit
+               = "gr_fill_arc"
+let fill_ellipse x y rx ry = fill_arc x y rx ry 0 360
+let fill_circle x y r = fill_arc x y r r 0 360
+
+(* Text *)
+
+external draw_char : char -> unit = "gr_draw_char"
+external draw_string : string -> unit = "gr_draw_string"
+external set_font : string -> unit = "gr_set_font"
+let set_text_size sz = ()
+external text_size : string -> int * int = "gr_text_size"
+
+(* Images *)
+
+type image
+
+let transp = -1
+
+external make_image : color array array -> image = "gr_make_image"
+external dump_image : image -> color array array = "gr_dump_image"
+external draw_image : image -> int -> int -> unit = "gr_draw_image"
+external create_image : int -> int -> image = "gr_create_image"
+external blit_image : image -> int -> int -> unit = "gr_blit_image"
+
+let get_image x y w h =
+  let image = create_image w h in
+  blit_image image x y;
+  image
+
+(* Events *)
+
+type status =
+  { mouse_x : int;
+    mouse_y : int;
+    button : bool;
+    keypressed : bool;
+    key : char }
+
+type event =
+    Button_down
+  | Button_up
+  | Key_pressed
+  | Mouse_motion
+  | Poll
+
+external wait_next_event : event list -> status = "gr_wait_event"
+
+let mouse_pos () =
+  let e = wait_next_event [Poll] in (e.mouse_x, e.mouse_y)
+
+let button_down () =
+  let e = wait_next_event [Poll] in e.button
+
+let read_key () =
+  let e = wait_next_event [Key_pressed] in e.key
+
+let key_pressed () =
+  let e = wait_next_event [Poll] in e.keypressed
+
+(*** Sound *)
+
+external sound : int -> int -> unit = "gr_sound"
diff --git a/otherlibs/graph/graphics.mli b/otherlibs/graph/graphics.mli
new file mode 100644
index 000000000..606aaf8cf
--- /dev/null
+++ b/otherlibs/graph/graphics.mli
@@ -0,0 +1,214 @@
+(* Machine-independent graphics primitives *)
+
+exception Graphic_failure of string
+        (* Raised by the functions below when they encounter an error. *)
+
+(*** Initializations *)
+
+val open_graph: string -> unit
+        (* Show the graphics window or switch the screen to graphic mode.
+           The graphics window is cleared. The string argument is used to
+           pass optional information on the desired graphics mode, the
+           graphics window size, and so on. Its interpretation is
+           implementation-dependent. If the empty string is given, a sensible
+           default is selected. *)
+val close_graph: unit -> unit
+        (* Delete the graphics window or switch the screen back to
+           text mode. *)
+external clear_graph : unit -> unit = "gr_clear_graph"
+        (* Erase the graphics window. *)
+external size_x : unit -> int = "gr_size_x"
+external size_y : unit -> int = "gr_size_y"
+        (* Return the size of the graphics window. Coordinates of the screen
+           pixels range over [0 .. size_x()-1] and [0 .. size_y()-1].
+           Drawings outside of this rectangle are clipped, without causing
+           an error. The origin (0,0) is at the lower left corner. *)
+
+(*** Colors *)
+
+type color = int
+        (* A color is specified by its R, G, B components. Each component
+           is in the range [0..255]. The three components are packed in
+           an [int]: [0xRRGGBB], where [RR] are the two hexadecimal digits for
+           the red component, [GG] for the green component, [BB] for the
+           blue component. *)
+
+val rgb: int -> int -> int -> int
+        (* [rgb r g b] returns the integer encoding the color with red
+           component [r], green component [g], and blue component [b].
+           [r], [g] and [b] are in the range [0..255]. *)
+
+external set_color : color -> unit = "gr_set_color"
+        (* Set the current drawing color. *)
+
+val black : color
+val white : color
+val red : color
+val green : color
+val blue : color
+val yellow : color
+val cyan : color
+val magenta : color
+        (* Some predefined colors. *)
+
+val background: color
+val foreground: color
+        (* Default background and foreground colors (usually, either black
+           foreground on a white background or white foreground on a
+           black background).
+           [clear_graph] fills the screen with the [background] color.
+           The initial drawing color is [foreground]. *)
+
+(*** Point and line drawing *)
+
+external plot : int -> int -> unit = "gr_plot"
+        (* Plot the given point with the current drawing color. *)
+external point_color : int -> int -> color = "gr_point_color"
+        (* Return the color of the given point. *)
+external moveto : int -> int -> unit = "gr_moveto"
+        (* Position the current point. *)
+external current_point : unit -> int * int = "gr_current_point"
+        (* Return the position of the current point. *)
+external lineto : int -> int -> unit = "gr_lineto"
+        (* Draw a line with endpoints the current point and the given point,
+           and move the current point to the given point. *)
+external draw_arc : int -> int -> int -> int -> int -> int -> unit
+               = "gr_draw_arc"
+        (* [draw_arc x y rx ry a1 a2] draws an elliptical arc with center
+           [x,y], horizontal radius [rx], vertical radius [ry], from angle
+           [a1] to angle [a2] (in degrees). The current point is unchanged. *)
+val draw_ellipse : int -> int -> int -> int -> unit
+        (* [draw_ellipse x y rx ry] draws an ellipse with center
+           [x,y], horizontal radius [rx] and vertical radius [ry].
+           The current point is unchanged.  *)
+val draw_circle : int -> int -> int -> unit
+        (* [draw_circle x y r] draws a circle with center [x,y] and
+           radius [r]. The current point is unchanged. *)
+external set_line_width : int -> unit = "gr_set_line_width"
+        (* Set the width of points and lines drawn with the functions above.
+           Under X Windows, [set_line_width 0] selects a width of 1 pixel
+           and a faster, but less precise drawing algorithm than the one
+           used when [set_line_width 1] is specified. *)
+
+(*** Text drawing *)
+
+external draw_char : char -> unit = "gr_draw_char"
+external draw_string : string -> unit = "gr_draw_string"
+        (* Draw a character or a character string with lower left corner
+           at current position. After drawing, the current position is set
+           to the lower right corner of the text drawn. *)
+external set_font : string -> unit = "gr_set_font"
+val set_text_size : int -> unit
+        (* Set the font and character size used for drawing text.
+           The interpretation of the arguments to [set_font] and
+           [set_text_size] is implementation-dependent. *)
+external text_size : string -> int * int = "gr_text_size"
+        (* Return the dimensions of the given text, if it were drawn with
+           the current font and size. *)
+
+(*** Filling *)
+
+external fill_rect : int -> int -> int -> int -> unit = "gr_fill_rect"
+        (* [fill_rect x y w h] fills the rectangle with lower left corner
+           at [x,y], width [w] and heigth [h], with the current color. *)
+external fill_poly : (int * int) array -> unit = "gr_fill_poly"
+        (* Fill the given polygon with the current color. The array
+           contains the coordinates of the vertices of the polygon. *)
+external fill_arc : int -> int -> int -> int -> int -> int -> unit
+               = "gr_fill_arc"
+        (* Fill an elliptical pie slice with the current color. The
+           parameters are the same as for [draw_arc]. *)
+val fill_ellipse : int -> int -> int -> int -> unit
+        (* Fill an ellipse with the current color. The
+           parameters are the same as for [draw_ellipse]. *)
+val fill_circle : int -> int -> int -> unit
+        (* Fill a circle with the current color. The
+           parameters are the same as for [draw_circle]. *)
+
+(*** Images *)
+
+type image
+        (* The abstract type for images, in internal representation.
+           Externally, images are represented as matrices of colors. *)
+
+val transp : color
+        (* In matrices of colors, this color represent a ``transparent''
+           point: when drawing the corresponding image, all pixels on the
+           screen corresponding to a transparent pixel in the image will
+           not be modified, while other points will be set to the color
+           of the corresponding point in the image. This allows superimposing
+           an image over an existing background. *)
+
+external make_image : color array array -> image = "gr_make_image"
+        (* Convert the given color matrix to an image.
+           Each sub-array represents one horizontal line. All sub-arrays
+           must have the same length; otherwise, exception [Graphic_failure]
+           is raised. *)
+external dump_image : image -> color array array = "gr_dump_image"
+        (* Convert an image to a color matrix. *)
+external draw_image : image -> int -> int -> unit = "gr_draw_image"
+        (* Draw the given image with lower left corner at the given point. *)
+val get_image : int -> int -> int -> int -> image
+        (* Capture the contents of a rectangle on the screen as an image.
+           The parameters are the same as for [fill_rect]. *)
+external create_image : int -> int -> image = "gr_create_image"
+        (* [create_image w h] returns a new image [w] pixels wide and [h]
+           pixels tall, to be used in conjunction with [blit_image].
+           The initial image contents are random. *)
+external blit_image : image -> int -> int -> unit = "gr_blit_image"
+        (* [blit_image img x y] copies screen pixels into the image [img],
+           modifying [img] in-place. The pixels copied are those inside the
+           rectangle with lower left corner at [x,y], and width and height
+           equal to those of the image. *)
+
+(*** Mouse and keyboard events *)
+
+type status =
+  { mouse_x : int;              (* X coordinate of the mouse *)
+    mouse_y : int;              (* Y coordinate of the mouse *)
+    button : bool;              (* true if a mouse button is pressed *)
+    keypressed : bool;          (* true if a key has been pressed *)
+    key : char }                (* the character for the key pressed *)
+        (* To report events. *)
+
+type event =
+    Button_down                 (* A mouse button is pressed *)
+  | Button_up                   (* A mouse button is released *)
+  | Key_pressed                 (* A key is pressed *)
+  | Mouse_motion                (* The mouse is moved *)
+  | Poll                        (* Don't wait; return immediately *)
+        (* To specify events to wait for. *)
+
+external wait_next_event : event list -> status = "gr_wait_event"
+        (* Wait until one of the events specified in the given event list
+           occurs, and return the status of the mouse and keyboard at
+           that time. If [Poll] is given in the event list, return immediately
+           with the current status. If the mouse cursor is outside of the
+           graphics window, the [mouse_x] and [mouse_y] fields of the event are
+           outside the range [0..size_x()-1, 0..size_y()-1]. Keypresses
+           are queued, and dequeued one by one when the [Key_pressed]
+           event is specified. *)
+
+(*** Mouse and keyboard polling *)
+
+val mouse_pos : unit -> int * int
+        (* Return the position of the mouse cursor, relative to the
+           graphics window. If the mouse cursor is outside of the graphics
+           window, [mouse_pos()] returns a point outside of the range
+           [0..size_x()-1, 0..size_y()-1]. *)
+val button_down : unit -> bool
+        (* Return [true] if the mouse button is pressed, [false] otherwise. *)
+val read_key : unit -> char
+        (* Wait for a key to be pressed, and return the corresponding
+           character. Keypresses are queued. *)
+val key_pressed : unit -> bool
+        (* Return [true] if a keypress is available; that is, if [read_key]
+           would not block. *)
+
+(*** Sound *)
+
+external sound : int -> int -> unit = "gr_sound"
+        (* [sound freq dur] plays a sound at frequency [freq] (in hertz)
+           for a duration [dur] (in milliseconds). On the Macintosh,
+           the frequency is rounded to the nearest note in the equal-tempered
+           scale. *)
diff --git a/otherlibs/graph/image.c b/otherlibs/graph/image.c
new file mode 100644
index 000000000..75b685a87
--- /dev/null
+++ b/otherlibs/graph/image.c
@@ -0,0 +1,77 @@
+#include "libgraph.h"
+#include "image.h"
+#include <alloc.h>
+
+static void gr_free_image(im)
+     value im;
+{
+  XFreePixmap(grdisplay, Data_im(im));
+  if (Mask_im(im) != None) XFreePixmap(grdisplay, Mask_im(im));
+}
+
+value gr_new_image(w, h)
+     int w, h;
+{
+  value res = alloc_shr(Grimage_wosize, Final_tag);
+  Final_fun(res) = gr_free_image;
+  Width_im(res) = w;
+  Height_im(res) = h;
+  Data_im(res) = XCreatePixmap(grdisplay, grwindow.win, w, h, 
+                               XDefaultDepth(grdisplay, grscreen));
+  Mask_im(res) = None;
+  return res;
+}
+
+value gr_create_image(vw, vh)
+     value vw, vh;
+{
+  gr_check_open();
+  return gr_new_image(Int_val(vw), Int_val(vh));
+}
+
+value gr_blit_image(im, vx, vy)
+     value im, vx, vy;
+{
+  int x = Int_val(vx);
+  int y = Int_val(vy);
+  gr_check_open();
+  XCopyArea(grdisplay, grbstore.win, Data_im(im), grbstore.gc,
+            x, Bcvt(y) + 1 - Height_im(im),
+            Width_im(im), Height_im(im),
+            0, 0);
+  return Val_unit;
+}
+
+value gr_draw_image(im, vx, vy)
+     value im, vx, 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);
+
+  gr_check_open();
+  if (Mask_im(im) != None) {
+    XSetClipOrigin(grdisplay, grwindow.gc, x, wy);
+    XSetClipMask(grdisplay, grwindow.gc, Mask_im(im));
+    XSetClipOrigin(grdisplay, grbstore.gc, x, by);
+    XSetClipMask(grdisplay, grbstore.gc, Mask_im(im));
+  }
+  XCopyArea(grdisplay, Data_im(im), grwindow.win, grwindow.gc,
+            0, 0,
+            Width_im(im), Height_im(im),
+            x, wy);
+  XCopyArea(grdisplay, Data_im(im), grbstore.win, grbstore.gc,
+            0, 0,
+            Width_im(im), Height_im(im),
+            x, by);
+  if (Mask_im(im) != None) {
+    XSetClipMask(grdisplay, grwindow.gc, None);
+    XSetClipMask(grdisplay, grbstore.gc, None);
+  }
+  XFlush(grdisplay);
+  return Val_unit;
+}
+
+
+            
diff --git a/otherlibs/graph/image.h b/otherlibs/graph/image.h
new file mode 100644
index 000000000..761cb16aa
--- /dev/null
+++ b/otherlibs/graph/image.h
@@ -0,0 +1,18 @@
+struct grimage {
+  final_fun f;                  /* Finalization function */
+  int width, height;            /* Dimensions of the image */
+  Pixmap data;                  /* Pixels */
+  Pixmap mask;                  /* Mask for transparent points, or None */
+};
+
+#define Grimage_wosize \
+  ((sizeof(struct grimage) + sizeof(value) - 1) / sizeof(value))
+
+#define Width_im(i) (((struct grimage *)(i))->width)
+#define Height_im(i) (((struct grimage *)(i))->height)
+#define Data_im(i) (((struct grimage *)(i))->data)
+#define Mask_im(i) (((struct grimage *)(i))->mask)
+
+#define Transparent (-1)
+
+value gr_new_image();
diff --git a/otherlibs/graph/libgraph.h b/otherlibs/graph/libgraph.h
new file mode 100644
index 000000000..60b9f6db9
--- /dev/null
+++ b/otherlibs/graph/libgraph.h
@@ -0,0 +1,57 @@
+#include <stdio.h>
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+#include <mlvalues.h>
+
+struct canvas {
+  int w, h;                     /* Dimensions of the drawable */
+  Drawable win;                 /* The drawable itself */
+  GC gc;                        /* The associated graphics context */
+};
+
+Display * grdisplay;            /* The display connection */
+int grscreen;                   /* The screen number */
+Colormap grcolormap;            /* The color map */
+struct canvas grwindow;         /* The graphics window */
+struct canvas grbstore;         /* The pixmap used for backing store */
+int grwhite, grblack;           /* Black and white pixels */
+int grx, gry;                   /* Coordinates of the current point */
+unsigned long grcolor;          /* Current drawing color */
+extern XFontStruct * grfont;    /* Current font */
+
+#define Wcvt(y) (grwindow.h - 1 - (y))
+#define Bcvt(y) (grbstore.h - 1 - (y))
+#define WtoB(y) ((y) + grbstore.h - grwindow.h)
+#define min(a,b) ((a) < (b) ? (a) : (b))
+#define max(a,b) ((a) > (b) ? (a) : (b))
+
+#define DEFAULT_SCREEN_WIDTH 600
+#define DEFAULT_SCREEN_HEIGHT 450
+#define BORDER_WIDTH 2
+#define WINDOW_NAME "Caml Light graphics"
+#define ICON_NAME "Caml Light graphics"
+#define DEFAULT_EVENT_MASK \
+          (ExposureMask | KeyPressMask | StructureNotifyMask)
+#define DEFAULT_FONT "fixed"
+#define SIZE_QUEUE 256
+
+/* To handle events asynchronously */
+#ifdef HAS_ASYNC_IO
+#define USE_ASYNC_IO
+#define EVENT_SIGNAL SIGIO
+#else
+#ifdef HAS_SETITIMER
+#define USE_INTERVAL_TIMER
+#define EVENT_SIGNAL SIGALRM
+#else
+#define USE_ALARM
+#define EVENT_SIGNAL SIGALRM
+#endif
+#endif
+
+void gr_fail();
+void gr_check_open();
+unsigned long gr_pixel_rgb();
+int gr_rgb_pixel();
+void gr_handle_simple_event();
+void gr_enqueue_char();
diff --git a/otherlibs/graph/make_img.c b/otherlibs/graph/make_img.c
new file mode 100644
index 000000000..6c9570def
--- /dev/null
+++ b/otherlibs/graph/make_img.c
@@ -0,0 +1,79 @@
+#include "libgraph.h"
+#include "image.h"
+#include <memory.h>
+
+value gr_make_image(m)
+     value m;
+{
+  int width, height;
+  value im;
+  Bool has_transp;
+  XImage * idata, * imask;
+  char * bdata, * bmask;
+  int i, j, rgb;
+  value line;
+  GC gc;
+
+  gr_check_open();
+  height = Wosize_val(m);
+  if (height == 0) return gr_new_image(0, 0);
+  width = Wosize_val(Field(m, 0));
+  for (i = 1; i < height; i++)
+    if (Wosize_val(Field(m, i)) != width)
+      gr_fail("make_image: lines of different lengths", NULL);
+
+  /* Build an XImage for the data part of the image */
+  idata =
+    XCreateImage(grdisplay, DefaultVisual(grdisplay, grscreen),
+                 XDefaultDepth(grdisplay, grscreen),
+                 ZPixmap, 0, NULL, width, height,
+                 BitmapPad(grdisplay), 0);
+  bdata = (char *) stat_alloc(height * idata->bytes_per_line);
+  idata->data = bdata;
+  has_transp = False;
+
+  for (i = 0; i < height; i++) {
+    line = Field(m, i);
+    for (j = 0; j < width; j++) {
+      rgb = Int_val(Field(line, j));
+      if (rgb == Transparent) { has_transp = True; rgb = 0; }
+      XPutPixel(idata, j, i, gr_pixel_rgb(rgb));
+    }
+  }
+
+  /* If the matrix contains transparent points,
+     build an XImage for the mask part of the image */
+  if (has_transp) {
+    imask =
+      XCreateImage(grdisplay, DefaultVisual(grdisplay, grscreen),
+                   1, ZPixmap, 0, NULL, width, height,
+                   BitmapPad(grdisplay), 0);
+    bmask = (char *) stat_alloc(height * imask->bytes_per_line);
+    imask->data = bmask;
+
+    for (i = 0; i < height; i++) {
+      line = Field(m, i);
+      for (j = 0; j < width; j++) {
+        rgb = Int_val(Field(line, j));
+        XPutPixel(imask, j, i, rgb != Transparent);
+      }
+    }
+  }
+
+  /* Allocate the image and store the XImages into the Pixmaps */
+  im = gr_new_image(width, height);
+  gc = XCreateGC(grdisplay, Data_im(im), 0, NULL);
+  XPutImage(grdisplay, Data_im(im), gc, idata, 0, 0, 0, 0, width, height);
+  XDestroyImage(idata);
+  XFreeGC(grdisplay, gc);
+  if (has_transp) {
+    Mask_im(im) = XCreatePixmap(grdisplay, grwindow.win, width, height, 1);
+    gc = XCreateGC(grdisplay, Mask_im(im), 0, NULL);
+    XPutImage(grdisplay, Mask_im(im), gc, imask, 0, 0, 0, 0, width, height);
+    XDestroyImage(imask);
+    XFreeGC(grdisplay, gc);
+  }
+  XFlush(grdisplay);
+  return im;
+}
+
diff --git a/otherlibs/graph/open.c b/otherlibs/graph/open.c
new file mode 100644
index 000000000..4354033b9
--- /dev/null
+++ b/otherlibs/graph/open.c
@@ -0,0 +1,339 @@
+#include <fcntl.h>
+#include <signal.h>
+#include "libgraph.h"
+#include <alloc.h>
+#include <fail.h>
+#include <memory.h>
+#ifdef HAS_SETITIMER
+#include <sys/time.h>
+#endif
+
+static Bool gr_initialized = False;
+
+static int gr_error_handler(), 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 */
+    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 SA_RESTART
+    { struct sigaction action;
+      sigaction(EVENT_SIGNAL, NULL, &action);
+      action.sa_flags |= SA_RESTART;
+      sigaction(EVENT_SIGNAL, &action, NULL);
+    }
+#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);
+    XCloseDisplay(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;
+
+value gr_register_graphic_failure(exn)
+     value exn;
+{
+  graphic_failure_exn = Field(exn, 0);
+  register_global_root(&graphic_failure_exn);
+  return Val_unit;
+}
+
+void gr_fail(fmt, arg)
+     char * fmt, * arg;
+{
+  char buffer[1024];
+  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;
+}
+
diff --git a/otherlibs/graph/point_col.c b/otherlibs/graph/point_col.c
new file mode 100644
index 000000000..757cf4720
--- /dev/null
+++ b/otherlibs/graph/point_col.c
@@ -0,0 +1,17 @@
+#include "libgraph.h"
+
+value gr_point_color(vx, vy)
+     value vx, vy;
+{
+  int x = Int_val(vx);
+  int y = Int_val(vy);
+  XImage * im;
+  int rgb;
+
+  im = XGetImage(grdisplay, grbstore.win, x, Bcvt(y), 1, 1, (-1), ZPixmap);
+  rgb = gr_rgb_pixel(XGetPixel(im, 0, 0));
+  XDestroyImage(im);
+  return Val_int(rgb);
+}
+
+                     
diff --git a/otherlibs/graph/sound.c b/otherlibs/graph/sound.c
new file mode 100644
index 000000000..ad9f6240b
--- /dev/null
+++ b/otherlibs/graph/sound.c
@@ -0,0 +1,21 @@
+#include "libgraph.h"
+
+value gr_sound(vfreq, vdur)
+     value vfreq, vdur;
+{
+  XKeyboardControl kbdcontrol;
+
+  kbdcontrol.bell_pitch = Int_val(vfreq);
+  kbdcontrol.bell_duration = Int_val(vdur);
+  XChangeKeyboardControl(grdisplay, KBBellPitch | KBBellDuration,
+                         &kbdcontrol);
+  XBell(grdisplay, 0);
+  kbdcontrol.bell_pitch = -1;   /* restore default value */
+  kbdcontrol.bell_duration = -1; /* restore default value */
+  XChangeKeyboardControl(grdisplay, KBBellPitch | KBBellDuration,
+                         &kbdcontrol);
+  XFlush(grdisplay);
+  return Val_unit;
+}
+
+
diff --git a/otherlibs/graph/text.c b/otherlibs/graph/text.c
new file mode 100644
index 000000000..22961f528
--- /dev/null
+++ b/otherlibs/graph/text.c
@@ -0,0 +1,67 @@
+#include "libgraph.h"
+
+XFontStruct * grfont = NULL;
+
+static void gr_font(fontname)
+     char * fontname;
+{
+  XFontStruct * font = XLoadQueryFont(grdisplay, fontname);
+  if (font == NULL) gr_fail("cannot find font %s", fontname);
+  if (grfont != NULL) XFreeFont(grdisplay, grfont);
+  grfont = font;
+  XSetFont(grdisplay, grwindow.gc, grfont->fid);
+  XSetFont(grdisplay, grbstore.gc, grfont->fid);
+}
+
+value gr_set_font(fontname)
+     value fontname;
+{
+  gr_check_open();
+  gr_font(String_val(fontname));
+  return Val_unit;
+}
+
+static void gr_draw_text(txt, len)
+     char * txt;
+     int len;
+{
+  if (grfont == NULL) gr_font(DEFAULT_FONT);
+  XDrawString(grdisplay, grwindow.win, grwindow.gc,
+              grx, Wcvt(gry) - grfont->descent + 1, txt, len);
+  XDrawString(grdisplay, grbstore.win, grbstore.gc,
+              grx, Bcvt(gry) - grfont->descent + 1, txt, len);
+  grx += XTextWidth(grfont, txt, len);
+  XFlush(grdisplay);
+}
+
+value gr_draw_char(chr)
+     value chr;
+{
+  char str[1];
+  gr_check_open();
+  str[0] = Int_val(chr);
+  gr_draw_text(str, 1);
+  return Val_unit;
+}
+  
+value gr_draw_string(str)
+     value str;
+{
+  gr_check_open();
+  gr_draw_text(String_val(str), string_length(str));
+  return Val_unit;
+}
+
+value gr_text_size(str)
+     value str;
+{
+  int width;
+  value res;
+  gr_check_open();
+  if (grfont == NULL) gr_font(DEFAULT_FONT);
+  width = XTextWidth(grfont, String_val(str), string_length(str));
+  res = alloc_tuple(2);
+  Field(res, 0) = Val_int(width);
+  Field(res, 1) = Val_int(grfont->ascent + grfont->descent);
+  return res;
+}
author	Xavier Leroy <xavier.leroy@inria.fr>	1995-05-08 17:04:35 +0000
committer	Xavier Leroy <xavier.leroy@inria.fr>	1995-05-08 17:04:35 +0000
commit	e22a62afc8cb34a5a491b9da3a777e42d95f351d (patch)
tree	916924829b31dc561121fec288b042e6dfe81aa6 /otherlibs/graph
parent	3844ccfcf176f5d3efd9df040f9134402b8f4d76 (diff)