Nouvelles fonctions flush et autoflush destinées à permettre le double

buffering. (Alexandre Miquel pour la version Unix uniquement.)


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2795 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

11 files changed, 124 insertions, 62 deletions

diff --git a/otherlibs/graph/color.c b/otherlibs/graph/color.c
index 65a5a3ad60..2bde01cce1 100644
--- a/otherlibs/graph/color.c
+++ b/otherlibs/graph/color.c
@@ -61,8 +61,8 @@ unsigned long gr_pixel_rgb(int rgb)
   if (direct_rgb){
     switch ( bits_per_pixel ){
     case 16:
-      tmp = ((r >> 3) << 11) + ((g >> 2) << 5) + ((b >> 3) << 0);
-      return (unsigned long) tmp;
+	tmp = ((r >> 3) << 11) + ((g >> 2) << 5) + ((b >> 3) << 0);
+	return (unsigned long) tmp;
     case 32:
       return (r << 16) + (g << 8) + (b << 0);
     }
@@ -75,13 +75,13 @@ unsigned long gr_pixel_rgb(int rgb)
     if (color_cache[i].rgb == rgb) return color_cache[i].pixel;
     i = (i + 1) & (Color_cache_size - 1);
     if (i == h) {
-      /* Cache is full.  Instead of inserting at slot h, which causes
-         thrashing if many colors hash to the same value,
-         insert at h + n where n is pseudo-random and
-         smaller than Color_cache_slack */
-      int slack = num_overflows++ & (Color_cache_slack - 1);
-      i = (i + slack) & (Color_cache_size - 1);
-      break;
+	/* Cache is full.  Instead of inserting at slot h, which causes
+	   thrashing if many colors hash to the same value,
+	   insert at h + n where n is pseudo-random and
+	   smaller than Color_cache_slack */
+	int slack = num_overflows++ & (Color_cache_slack - 1);
+	i = (i + slack) & (Color_cache_size - 1);
+	break;
     }
   }
   color.red = r * 0x101;
diff --git a/otherlibs/graph/draw.c b/otherlibs/graph/draw.c
index 72a9bb65ba..3a95022b97 100644
--- a/otherlibs/graph/draw.c
+++ b/otherlibs/graph/draw.c
@@ -20,9 +20,11 @@ value gr_plot(value vx, value vy)
   int x = Int_val(vx);
   int y = Int_val(vy);
   gr_check_open();
-  XDrawPoint(grdisplay, grwindow.win, grwindow.gc, x, Wcvt(y));
   XDrawPoint(grdisplay, grbstore.win, grbstore.gc, x, Bcvt(y));
-  XFlush(grdisplay);
+  if(grautoflush) {
+    XDrawPoint(grdisplay, grwindow.win, grwindow.gc, x, Wcvt(y));
+    XFlush(grdisplay);
+  }
   return Val_unit;
 }
 
@@ -47,13 +49,15 @@ value gr_lineto(value vx, value vy)
   int x = Int_val(vx);
   int y = Int_val(vy);
   gr_check_open();
-  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, Bcvt(gry), x, Bcvt(y));
+  if(grautoflush) {
+    XDrawLine(grdisplay, grwindow.win, grwindow.gc,
+	      grx, Wcvt(gry), x, Wcvt(y));
+    XFlush(grdisplay);
+  }
   grx = x;
   gry = y;
-  XFlush(grdisplay);
   return Val_unit;
 }
 
@@ -67,11 +71,13 @@ value gr_draw_arc_nat(value vx, value vy, value vrx, value vry, value va1, value
   int a2 = Int_val(va2);
 
   gr_check_open();
-  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);
+	   x - rx, Bcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64);
+  if(grautoflush) {
+    XDrawArc(grdisplay, grwindow.win, grwindow.gc,
+	     x - rx, Wcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64);
+    XFlush(grdisplay);
+  }
   return Val_unit;
 }
 
@@ -91,4 +97,3 @@ value gr_set_line_width(value vwidth)
                      width, LineSolid, CapRound, JoinRound);
   return Val_unit;
 }
-
diff --git a/otherlibs/graph/fill.c b/otherlibs/graph/fill.c
index 50b6d32e9d..f3b86a7567 100644
--- a/otherlibs/graph/fill.c
+++ b/otherlibs/graph/fill.c
@@ -23,11 +23,13 @@ value gr_fill_rect(value vx, value vy, value vw, value vh)
   int h = Int_val(vh);
 
   gr_check_open();
-  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);
+		 x, Bcvt(y) - h + 1, w, h);
+  if(grautoflush) {
+    XFillRectangle(grdisplay, grwindow.win, grwindow.gc,
+		   x, Wcvt(y) - h + 1, w, h);
+    XFlush(grdisplay);
+  }
   return Val_unit;
 }
 
@@ -41,16 +43,17 @@ value gr_fill_poly(value 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);
+    points[i].y = Bcvt(Int_val(Field(Field(array, i), 1)));
   }
   XFillPolygon(grdisplay, grbstore.win, grbstore.gc, points,
-               npoints, Complex, CoordModeOrigin);
-  XFlush(grdisplay);
+	       npoints, Complex, CoordModeOrigin);
+  if(grautoflush) {
+    for (i = 0; i < npoints; i++)
+      points[i].y = BtoW(points[i].y);
+    XFillPolygon(grdisplay, grwindow.win, grwindow.gc, points,
+		 npoints, Complex, CoordModeOrigin);
+    XFlush(grdisplay);
+  }
   stat_free((char *) points);
   return Val_unit;
 }
@@ -65,11 +68,13 @@ value gr_fill_arc_nat(value vx, value vy, value vrx, value vry, value va1, value
   int a2 = Int_val(va2);
 
   gr_check_open();
-  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);
+	   x - rx, Bcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64);
+  if(grautoflush) {
+    XFillArc(grdisplay, grwindow.win, grwindow.gc,
+	     x - rx, Wcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64);
+    XFlush(grdisplay);
+  }
   return Val_unit;
 }
 
@@ -77,4 +82,3 @@ value gr_fill_arc(value *argv, int argc)
 {
   return gr_fill_arc_nat(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
 }
-
diff --git a/otherlibs/graph/graphics.ml b/otherlibs/graph/graphics.ml
index 35ae7faec2..c2b8df0376 100644
--- a/otherlibs/graph/graphics.ml
+++ b/otherlibs/graph/graphics.ml
@@ -43,6 +43,11 @@ external clear_graph : unit -> unit = "gr_clear_graph"
 external size_x : unit -> int = "gr_size_x"
 external size_y : unit -> int = "gr_size_y"
 
+(* Double-buffering *)
+
+external autoflush : bool -> unit = "gr_autoflush"
+external flush : unit -> unit = "gr_flush"
+
 (* Colors *)
 
 type color = int
diff --git a/otherlibs/graph/graphics.mli b/otherlibs/graph/graphics.mli
index f6a97993f9..447594a9ad 100644
--- a/otherlibs/graph/graphics.mli
+++ b/otherlibs/graph/graphics.mli
@@ -38,6 +38,24 @@ external size_y : unit -> int = "gr_size_y"
            Drawings outside of this rectangle are clipped, without causing
            an error. The origin (0,0) is at the lower left corner. *)
 
+(*** Double-buffering *)
+
+external autoflush : bool -> unit = "gr_autoflush"
+        (* Set auto-flush mode on/off.  When turned off, drawings are done
+	   in the backing store window but no more in the graphics window
+	   itself.  This creates a simple effect of double-buffering, by
+	   allowing the user to do complex drawings in the backing store
+	   while keeping older drawings on the screen.  The contents
+	   of the backing-store is copied onto the graphics window by
+	   a call to [flush] (see below).  By default, auto-flush mode is
+	   on, and all drawings are done both in the backing-store and in
+	   the graphics window. *)
+
+external flush : unit -> unit = "gr_flush"
+        (* Flush the contents of the backing-store onto the graphics
+	   window.  This function is automatically called each time
+	   auto-flush mode is enabled. *)
+
 (*** Colors *)
 
 type color = int
@@ -87,7 +105,7 @@ external lineto : x:int -> y: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 :
-        x:int -> y:int -> rx:int -> ry:int -> start:int -> stop:int -> unit
+	x:int -> y:int -> rx:int -> ry:int -> start:int -> stop:int -> unit
                = "gr_draw_arc" "gr_draw_arc_nat"
         (* [draw_arc x y rx ry a1 a2] draws an elliptical arc with center
            [x,y], horizontal radius [rx], vertical radius [ry], from angle
diff --git a/otherlibs/graph/image.c b/otherlibs/graph/image.c
index 6e07847afc..c8792a7bd2 100644
--- a/otherlibs/graph/image.c
+++ b/otherlibs/graph/image.c
@@ -62,26 +62,28 @@ value gr_draw_image(value im, value vx, value vy)
 
   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));
+    if(grautoflush) {
+      XSetClipOrigin(grdisplay, grwindow.gc, x, wy);
+      XSetClipMask(grdisplay, grwindow.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(grautoflush)
+    XCopyArea(grdisplay, Data_im(im), grwindow.win, grwindow.gc,
+	      0, 0,
+	      Width_im(im), Height_im(im),
+	      x, wy);
   if (Mask_im(im) != None) {
-    XSetClipMask(grdisplay, grwindow.gc, None);
     XSetClipMask(grdisplay, grbstore.gc, None);
+    if(grautoflush)
+      XSetClipMask(grdisplay, grwindow.gc, None);
   }
-  XFlush(grdisplay);
+  if(grautoflush)
+    XFlush(grdisplay);
   return Val_unit;
 }
-
-
-            
diff --git a/otherlibs/graph/libgraph.h b/otherlibs/graph/libgraph.h
index 59cac28fc7..d0b4595919 100644
--- a/otherlibs/graph/libgraph.h
+++ b/otherlibs/graph/libgraph.h
@@ -29,6 +29,7 @@ extern Colormap grcolormap;     /* The color map */
 extern struct canvas grwindow;  /* The graphics window */
 extern struct canvas grbstore;  /* The pixmap used for backing store */
 extern int grwhite, grblack;    /* Black and white pixels */
+extern Bool grautoflush;        /* Auto-flush flag */
 extern int grx, gry;            /* Coordinates of the current point */
 extern unsigned long grcolor;   /* Current drawing color */
 extern XFontStruct * grfont;    /* Current font */
@@ -41,6 +42,7 @@ extern int bits_per_pixel;
 #define Wcvt(y) (grwindow.h - 1 - (y))
 #define Bcvt(y) (grbstore.h - 1 - (y))
 #define WtoB(y) ((y) + grbstore.h - grwindow.h)
+#define BtoW(y) ((y) + grwindow.h - grbstore.h)
 #define min(a,b) ((a) < (b) ? (a) : (b))
 #define max(a,b) ((a) > (b) ? (a) : (b))
 
diff --git a/otherlibs/graph/make_img.c b/otherlibs/graph/make_img.c
index ae655685bb..33cb61e722 100644
--- a/otherlibs/graph/make_img.c
+++ b/otherlibs/graph/make_img.c
@@ -50,7 +50,7 @@ value gr_make_image(value m)
     bits_per_pixel = idata->bits_per_pixel;
 #ifdef DIRECT_RGB_DEBUG
     fprintf(stderr, "Byte_order: %d = %s\n", byte_order,
-            byte_order ? "LSBFirst" : "MSBFirst");
+	    byte_order ? "LSBFirst" : "MSBFirst");
     fprintf(stderr, "Bitmp_unit: %d\n", bitmap_unit);
     fprintf(stderr, "Bits per pixel: %d\n", idata->bits_per_pixel);
 #endif
@@ -107,3 +107,4 @@ value gr_make_image(value m)
   XFlush(grdisplay);
   return im;
 }
+
diff --git a/otherlibs/graph/open.c b/otherlibs/graph/open.c
index cc00620df8..e6edfa5fc5 100644
--- a/otherlibs/graph/open.c
+++ b/otherlibs/graph/open.c
@@ -29,6 +29,7 @@ Colormap grcolormap;
 int grwhite, grblack;
 struct canvas grwindow;
 struct canvas grbstore;
+Bool grautoflush ;
 int grx, gry;
 unsigned long grcolor;
 extern XFontStruct * grfont;
@@ -138,6 +139,9 @@ value gr_open_graph(value arg)
                    0, 0, grbstore.w, grbstore.h);
     XSetForeground(grdisplay, grbstore.gc, grcolor);
     
+    /* Set the auto-flush flag */
+    grautoflush = True ;
+
     /* The global data structures are now correctly initialized.
        In particular, gr_sigio_handler can now handle events safely. */
     gr_initialized = True;
@@ -208,15 +212,17 @@ value gr_close_graph(void)
 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);
+  if(grautoflush) {
+    XSetForeground(grdisplay, grwindow.gc, grwhite);
+    XFillRectangle(grdisplay, grwindow.win, grwindow.gc,
+		   0, 0, grwindow.w, grwindow.h);
+    XSetForeground(grdisplay, grwindow.gc, grcolor);
+    XFlush(grdisplay);
+  }
   gr_init_color_cache();
   return Val_unit;
 }
@@ -233,6 +239,26 @@ value gr_size_y(void)
   return Val_int(grwindow.h);
 }
 
+value gr_flush(void)
+{
+  XCopyArea(grdisplay, grbstore.win, grwindow.win, grwindow.gc,
+	    0, grbstore.h - grwindow.h,
+	    grwindow.w, grwindow.h,
+	    0, 0);
+  XFlush(grdisplay);
+  return Val_unit ;
+}
+
+value gr_autoflush(value v)
+{
+  Bool old = grautoflush ;
+  grautoflush = Bool_val(v) ;
+  if(old == False && grautoflush == True)
+    return gr_flush() ;
+  else
+    return Val_unit ;
+}
+
 /* 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
@@ -360,4 +386,3 @@ static int gr_ioerror_handler(Display *display)
   gr_fail("fatal I/O error", NULL);
   return 0;
 }
-
diff --git a/otherlibs/graph/sound.c b/otherlibs/graph/sound.c
index 81ed82d184..cf7f147806 100644
--- a/otherlibs/graph/sound.c
+++ b/otherlibs/graph/sound.c
@@ -31,5 +31,3 @@ value gr_sound(value vfreq, value vdur)
   XFlush(grdisplay);
   return Val_unit;
 }
-
-
diff --git a/otherlibs/graph/text.c b/otherlibs/graph/text.c
index 3f2032a12b..d8d8d3f026 100644
--- a/otherlibs/graph/text.c
+++ b/otherlibs/graph/text.c
@@ -42,12 +42,14 @@ value gr_set_text_size (value sz)
 static void gr_draw_text(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);
+  if(grautoflush) {
+    XDrawString(grdisplay, grwindow.win, grwindow.gc,
+		grx, Wcvt(gry) - grfont->descent + 1, txt, len);
+    XFlush(grdisplay);
+  }
   grx += XTextWidth(grfont, txt, len);
-  XFlush(grdisplay);
 }
 
 value gr_draw_char(value chr)
@@ -58,7 +60,7 @@ value gr_draw_char(value chr)
   gr_draw_text(str, 1);
   return Val_unit;
 }
-  
+
 value gr_draw_string(value str)
 {
   gr_check_open();