Fusion des modifs faites sur la branche release jusqu'a la release 3.08.0

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

5 files changed, 222 insertions, 212 deletions

diff --git a/otherlibs/win32graph/Makefile.nt b/otherlibs/win32graph/Makefile.nt
index 1274182614..18c6410cb9 100644
--- a/otherlibs/win32graph/Makefile.nt
+++ b/otherlibs/win32graph/Makefile.nt
@@ -22,7 +22,7 @@ CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib
 CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib
 COMPFLAGS=-warn-error A
 
-COBJS=open.$(O) draw.$(O) dib.$(O)
+COBJS=open.$(O) draw.$(O) events.$(O) dib.$(O)
 CAMLOBJS=graphics.cmo
 WIN32LIBS=$(call SYSLIB,kernel32) $(call SYSLIB,gdi32) $(call SYSLIB,user32)
 
diff --git a/otherlibs/win32graph/draw.c b/otherlibs/win32graph/draw.c
index c4f1224b28..1bebe0208e 100644
--- a/otherlibs/win32graph/draw.c
+++ b/otherlibs/win32graph/draw.c
@@ -15,9 +15,11 @@
 #include <math.h>
 #include "mlvalues.h"
 #include "alloc.h"
+#include "fail.h"
 #include "libgraph.h"
 #include "custom.h"
 #include "memory.h"
+
 HDC gcMetaFile;
 int grdisplay_mode;
 int grremember_mode;
@@ -84,38 +86,18 @@ CAMLprim value caml_gr_lineto(value vx, value vy)
 
 CAMLprim value caml_gr_draw_rect(value vx, value vy, value vw, value vh)
 {
-#if 0
-        int x = Int_val(vx);
-        int y = Int_val(vy);
-        int w = Int_val(vw);
-        int h = Int_val(vh);
-
-        gr_check_open();
-        if(grdisplay_mode) {
-                Rectangle(grwindow.gc,x, Wcvt(y) , x+w, Wcvt(y+h));
-        }
-        if(grremember_mode) {
-                Rectangle(grwindow.gcBitmap,x, Wcvt(y), x+w, Wcvt(h+y));
-        }
-        return Val_unit;
-#else
         int     x, y, w, h;
         POINT pt[5];
         x=Int_val(vx);
-        y=Int_val(vy);
+        y=Wcvt(Int_val(vy));
         w=Int_val(vw);
         h=Int_val(vh);
 
-        pt[0].x = x;
-        pt[0].y = Wcvt(y-1);
-        pt[1].x = x+w;
-        pt[1].y = pt[0].y;
-        pt[2].x = pt[1].x;
-        pt[2].y = Wcvt(y+h-1);
-        pt[3].x = pt[0].x;
-        pt[3].y = pt[2].y;
-        pt[4].x = pt[0].x;
-        pt[4].y = pt[0].y;
+        pt[0].x = x;         pt[0].y = y - h;
+	pt[1].x = x + w;     pt[1].y = y - h;
+	pt[2].x = x + w;     pt[2].y = y;
+	pt[3].x = x;         pt[3].y = y;
+	pt[4].x = x;         pt[4].y = y - h;
         if (grremember_mode) {
                 Polyline(grwindow.gcBitmap,pt, 5);
         }
@@ -123,7 +105,6 @@ CAMLprim value caml_gr_draw_rect(value vx, value vy, value vw, value vh)
                 Polyline(grwindow.gc,pt, 5);
         }
         return Val_unit;
-#endif
 }
 
 CAMLprim value caml_gr_draw_text(value text,value x)
@@ -405,125 +386,6 @@ CAMLprim value caml_gr_text_size(value str)
         return res;
 }
 
-#if 0
-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(unsigned char c)
-{
-        if (QueueIsFull) return;
-        gr_queue[gr_tail] = c;
-        gr_tail++;
-        if (gr_tail >= SIZE_QUEUE) gr_tail = 0;
-}
-#endif
-
-#define Button_down             1
-#define Button_up               2
-#define Key_pressed             4
-#define Mouse_motion    8
-#define Poll                    16
-MSG * InspectMessages = NULL;
-
-CAMLprim value caml_gr_wait_event(value eventlist)
-{
-        value res;
-        int mask;
-        BOOL poll;
-        int mouse_x, mouse_y, button, key;
-        int root_x, root_y, win_x, win_y;
-        int r,i,stop;
-        unsigned int modifiers;
-        POINT pt;
-        MSG msg;
-
-        gr_check_open();
-        mask = 0;
-        poll = FALSE;
-        while (eventlist != Val_int(0)) {
-                switch (Int_val(Field(eventlist,0))) {
-                case 0:                     /* Button_down */
-                        mask |= Button_down;
-                        break;
-                case 1:                     /* Button_up */
-                        mask |= Button_up;
-                        break;
-                case 2:                     /* Key_pressed */
-                        mask |= Key_pressed;
-                        break;
-                case 3:                     /* Mouse_motion */
-                        mask |= Mouse_motion;
-                        break;
-                case 4:                     /* Poll */
-                        poll = TRUE;
-                        break;
-                }
-                eventlist = Field(eventlist,1);
-        }
-        mouse_x = -1;
-        mouse_y = -1;
-        button = 0;
-        key = -1;
-
-        if (poll) {
-                // Poll uses info on last event stored in global variables
-                mouse_x = MouseLastX;
-                mouse_y = MouseLastY;
-                button = MouseLbuttonDown | MouseMbuttonDown | MouseRbuttonDown;
-                key = LastKey;
-        }
-        else { // Not polled. Block for a message
-                InspectMessages = &msg;
-                do {
-                        WaitForSingleObject(EventHandle,INFINITE);
-                        stop = 0;
-                        switch (msg.message) {
-                        case WM_LBUTTONDOWN:
-                        case WM_MBUTTONDOWN:
-                        case WM_RBUTTONDOWN:
-                                button = 1;
-                                if (mask&Button_down) stop = 1;
-                                break;
-                        case WM_LBUTTONUP:
-                        case WM_MBUTTONUP:
-                        case WM_RBUTTONUP:
-                                button = 0;
-                                if (mask&Button_up) stop = 1;
-                                break;
-                        case WM_MOUSEMOVE:
-                                if (mask&Mouse_motion) stop = 1;
-                                break;
-                        case WM_CHAR:
-                                key = msg.wParam & 0xFF;
-                                if (mask&Key_pressed) stop = 1;
-                                break;
-			case WM_CLOSE:
-			        stop = 1;
-				break;
-                        }
-                        if (stop) {
-                                pt = msg.pt;
-                                MapWindowPoints(HWND_DESKTOP,grwindow.hwnd,&pt,1);
-                                mouse_x = pt.x;
-                                mouse_y = grwindow.height- 1 - pt.y;
-                        }
-			SetEvent(EventProcessedHandle);
-                } while (! stop);
-                InspectMessages = NULL;
-        }
-        res = alloc_small(5, 0);
-        Field(res, 0) = Val_int(mouse_x);
-        Field(res, 1) = Val_int(mouse_y);
-        Field(res, 2) = Val_bool(button);
-        Field(res, 3) = Val_bool(key != -1);
-        Field(res, 4) = Val_int(key & 0xFF);
-        return res;
-}
-
 CAMLprim value caml_gr_fill_poly(value vect)
 {
         int n_points, i;
diff --git a/otherlibs/win32graph/events.c b/otherlibs/win32graph/events.c
new file mode 100755
index 0000000000..9e0791c389
--- /dev/null
+++ b/otherlibs/win32graph/events.c
@@ -0,0 +1,200 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Objective Caml                            */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 2004 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../../LICENSE.  */
+/*                                                                     */
+/***********************************************************************/
+
+/* $Id$ */
+
+#include "mlvalues.h"
+#include "alloc.h"
+#include "libgraph.h"
+#include <windows.h>
+
+enum {
+  EVENT_BUTTON_DOWN = 1,
+  EVENT_BUTTON_UP = 2,
+  EVENT_KEY_PRESSED = 4,
+  EVENT_MOUSE_MOTION = 8
+};
+
+struct event_data {
+  short mouse_x, mouse_y;
+  unsigned char kind;
+  unsigned char button;
+  unsigned char key;
+};
+
+static struct event_data caml_gr_queue[SIZE_QUEUE];
+static unsigned int caml_gr_head = 0;       /* position of next read */
+static unsigned int caml_gr_tail = 0;       /* position of next write */
+
+static int caml_gr_event_mask = EVENT_KEY_PRESSED;
+static int last_button = 0;
+static LPARAM last_pos = 0;
+
+HANDLE caml_gr_queue_semaphore = NULL;
+CRITICAL_SECTION caml_gr_queue_mutex;
+
+void caml_gr_init_event_queue(void)
+{
+  if (caml_gr_queue_semaphore == NULL) {
+    caml_gr_queue_semaphore = CreateSemaphore(NULL, 0, SIZE_QUEUE, NULL);
+    InitializeCriticalSection(&caml_gr_queue_mutex);
+  }
+}
+
+#define QueueIsEmpty (caml_gr_tail == caml_gr_head)
+
+static void caml_gr_enqueue_event(int kind, LPARAM mouse_xy,
+                                  int button, int key)
+{
+  struct event_data * ev;
+
+  if ((caml_gr_event_mask & kind) == 0) return;
+  EnterCriticalSection(&caml_gr_queue_mutex);
+  ev = &(caml_gr_queue[caml_gr_tail]);
+  ev->kind = kind;
+  ev->mouse_x = GET_X_LPARAM(mouse_xy);
+  ev->mouse_y = GET_Y_LPARAM(mouse_xy);
+  ev->button = (button != 0);
+  ev->key = key;
+  caml_gr_tail = (caml_gr_tail + 1) % SIZE_QUEUE;
+  /* If queue was full, it now appears empty;
+     drop oldest entry from queue. */
+  if (QueueIsEmpty) {
+    caml_gr_head = (caml_gr_head + 1) % SIZE_QUEUE;
+  } else {
+    /* One more event in queue */
+    ReleaseSemaphore(caml_gr_queue_semaphore, 1, NULL);
+  }
+  LeaveCriticalSection(&caml_gr_queue_mutex);
+}
+
+void caml_gr_handle_event(UINT msg, WPARAM wParam, LPARAM lParam)
+{
+  switch (msg) {
+  case WM_LBUTTONDOWN:
+  case WM_RBUTTONDOWN:
+  case WM_MBUTTONDOWN:
+    last_button = 1;
+    last_pos = lParam;
+    caml_gr_enqueue_event(EVENT_BUTTON_DOWN, lParam, 1, 0);
+    break;
+
+  case WM_LBUTTONUP:
+  case WM_RBUTTONUP:
+  case WM_MBUTTONUP:
+    last_button = 0;
+    last_pos = lParam;
+    caml_gr_enqueue_event(EVENT_BUTTON_UP, lParam, 0, 0);
+    break;
+
+  case WM_CHAR:
+    caml_gr_enqueue_event(EVENT_KEY_PRESSED, last_pos, last_button, wParam);
+    break;
+
+  case WM_MOUSEMOVE:
+    last_pos = lParam;
+    caml_gr_enqueue_event(EVENT_MOUSE_MOTION, lParam, last_button, 0);
+    break;
+  }
+}
+
+static value caml_gr_wait_allocate_result(int mouse_x, int mouse_y,
+                                          int button,
+                                          int keypressed, int key)
+{
+  value res = alloc_small(5, 0);
+  Field(res, 0) = Val_int(mouse_x);
+  Field(res, 1) = Val_int(grwindow.height - 1 - mouse_y);
+  Field(res, 2) = Val_bool(button);
+  Field(res, 3) = Val_bool(keypressed);
+  Field(res, 4) = Val_int(key & 0xFF);
+  return res;
+}
+
+static value caml_gr_wait_event_poll(void)
+{
+  int key, keypressed, i;
+
+  /* Look inside event queue for pending KeyPress events */
+  EnterCriticalSection(&caml_gr_queue_mutex);
+  key = 0;
+  keypressed = 0;
+  for (i = caml_gr_head; i != caml_gr_tail; i = (i + 1) % SIZE_QUEUE) {
+    if (caml_gr_queue[i].kind == EVENT_KEY_PRESSED) {
+      keypressed = 1;
+      key = caml_gr_queue[i].key;
+      break;
+    }
+  }
+  LeaveCriticalSection(&caml_gr_queue_mutex);
+  /* Use global vars for mouse position and buttons */
+  return caml_gr_wait_allocate_result(GET_X_LPARAM(last_pos),
+                                      GET_Y_LPARAM(last_pos),
+                                      last_button,
+                                      keypressed, key);
+}
+
+static value caml_gr_wait_event_blocking(int mask)
+{
+  struct event_data ev;
+
+  /* Increase the selected events if needed */
+  caml_gr_event_mask |= mask;
+  /* Pop events from queue until one matches */
+  do {
+    /* Wait for event queue to be non-empty */
+    WaitForSingleObject(caml_gr_queue_semaphore, INFINITE);
+    /* Pop oldest event in queue */
+    EnterCriticalSection(&caml_gr_queue_mutex);
+    ev = caml_gr_queue[caml_gr_head];
+    /* Queue should never be empty at this point, but just in case... */
+    if (QueueIsEmpty) {
+      ev.kind = 0;
+    } else {
+      caml_gr_head = (caml_gr_head + 1) % SIZE_QUEUE;
+    }
+    LeaveCriticalSection(&caml_gr_queue_mutex);
+    /* Check if it matches */
+  } while ((ev.kind & mask) == 0);
+  return caml_gr_wait_allocate_result(ev.mouse_x, ev.mouse_y, ev.button,
+                                      ev.kind == EVENT_KEY_PRESSED,
+                                      ev.key);
+}
+
+CAMLprim value caml_gr_wait_event(value eventlist) /* ML */
+{
+  int mask, poll;
+
+  gr_check_open();
+  mask = 0;
+  poll = 0;
+  while (eventlist != Val_int(0)) {
+    switch (Int_val(Field(eventlist, 0))) {
+    case 0:                     /* Button_down */
+      mask |= EVENT_BUTTON_DOWN; break;
+    case 1:                     /* Button_up */
+      mask |= EVENT_BUTTON_UP; break;
+    case 2:                     /* Key_pressed */
+      mask |= EVENT_KEY_PRESSED; break;
+    case 3:                     /* Mouse_motion */
+      mask |= EVENT_MOUSE_MOTION; break;
+    case 4:                     /* Poll */
+      poll = 1; break;
+    }
+    eventlist = Field(eventlist, 1);
+  }
+  if (poll)
+    return caml_gr_wait_event_poll();
+  else
+    return caml_gr_wait_event_blocking(mask);
+}
diff --git a/otherlibs/win32graph/libgraph.h b/otherlibs/win32graph/libgraph.h
index acbe29cc18..6c32f15df6 100644
--- a/otherlibs/win32graph/libgraph.h
+++ b/otherlibs/win32graph/libgraph.h
@@ -45,9 +45,6 @@ extern int bits_per_pixel;
 #define BORDER_WIDTH 2
 #define WINDOW_NAME "Caml graphics"
 #define ICON_NAME "Caml graphics"
-#define DEFAULT_EVENT_MASK \
-          (ExposureMask | KeyPressMask | StructureNotifyMask)
-#define DEFAULT_FONT "fixed"
 #define SIZE_QUEUE 256
 
 void gr_fail(char *fmt, char *arg);
@@ -77,10 +74,5 @@ typedef struct tagWindow {
 
 extern GR_WINDOW grwindow;
 HFONT CreationFont(char *name);
-extern int MouseLbuttonDown,MouseMbuttonDown,MouseRbuttonDown;
-extern HANDLE EventHandle, EventProcessedHandle;
-extern MSG * InspectMessages;
-extern int MouseLbuttonDown,MouseMbuttonDown,MouseRbuttonDown;
-extern int MouseLastX, MouseLastY;
-extern int LastKey;
-
+extern void caml_gr_init_event_queue(void);
+extern void caml_gr_handle_event(UINT msg, WPARAM wParam, LPARAM lParam);
diff --git a/otherlibs/win32graph/open.c b/otherlibs/win32graph/open.c
index 654f550bfb..6376e5abe2 100644
--- a/otherlibs/win32graph/open.c
+++ b/otherlibs/win32graph/open.c
@@ -15,12 +15,11 @@
 #include <fcntl.h>
 #include <signal.h>
 #include "mlvalues.h"
+#include "fail.h"
 #include "libgraph.h"
 #include <windows.h>
+
 static value gr_reset(void);
-int MouseLbuttonDown,MouseMbuttonDown,MouseRbuttonDown;
-int MouseLastX, MouseLastY;
-int LastKey = -1;
 static long tid;
 static HANDLE threadHandle;
 HWND grdisplay = NULL;
@@ -36,11 +35,11 @@ int grcolor;
 extern HFONT * grfont;
 MSG msg;
 
-HANDLE EventHandle, EventProcessedHandle;
 static char *szOcamlWindowClass = "OcamlWindowClass";
 static BOOL gr_initialized = 0;
 CAMLprim value caml_gr_clear_graph(void);
 HANDLE hInst;
+
 HFONT CreationFont(char *name)
 {
    LOGFONT CurrentFont;
@@ -65,8 +64,11 @@ void SetCoordinates(HWND hwnd)
 
 void ResetForClose(HWND hwnd)
 {
+        DeleteDC(grwindow.tempDC);
+        DeleteDC(grwindow.gcBitmap);
         DeleteObject(grwindow.hBitmap);
         memset(&grwindow,0,sizeof(grwindow));
+        gr_initialized = 0;
 }
 
         
@@ -98,44 +100,9 @@ static LRESULT CALLBACK GraphicsWndProc(HWND hwnd,UINT msg,WPARAM wParam,LPARAM
         case WM_DESTROY:
                 ResetForClose(hwnd);
                 break;
-        case WM_LBUTTONDOWN:
-                MouseLbuttonDown = 1;
-                break;
-        case WM_LBUTTONUP:
-                MouseLbuttonDown = 0;
-                break;
-        case WM_RBUTTONDOWN:
-                MouseRbuttonDown = 1;
-                break;
-        case WM_RBUTTONUP:
-                MouseRbuttonDown = 0;
-                break;
-        case WM_MBUTTONDOWN:
-                MouseMbuttonDown = 1;
-                break;
-        case WM_MBUTTONUP:
-                MouseMbuttonDown = 0;
-                break;
-        case WM_CHAR:
-                LastKey = wParam & 0xFF;
-                break;
-        case WM_KEYUP:
-                LastKey = -1;
-                break;
-        case WM_MOUSEMOVE:
-#if 0
-                pt.x = GET_X_LPARAM(lParam);
-                pt.y = GET_Y_LPARAM(lParam);
-                MapWindowPoints(HWND_DESKTOP,grwindow.hwnd,&pt,1);
-                MouseLastX = pt.x;
-                MouseLastY = grwindow.height - 1 - pt.y;
-#else
-                MouseLastX = GET_X_LPARAM(lParam);
-                MouseLastY = grwindow.height - 1 - GET_Y_LPARAM(lParam);
-#endif
-                break;
         }
-        return DefWindowProc(hwnd,msg,wParam,lParam);
+        caml_gr_handle_event(msg, wParam, lParam);
+        return DefWindowProc(hwnd, msg, wParam, lParam);
 }
 
 int DoRegisterClass(void)
@@ -266,8 +233,7 @@ static DWORD WINAPI gr_open_graph_internal(value arg)
   grwindow.grx = 0;
   grwindow.gry = 0;
   
-  EventHandle = CreateEvent(NULL,0,0,NULL);
-  EventProcessedHandle = CreateEvent(NULL,0,0,NULL);
+  caml_gr_init_event_queue();
 
   /* The global data structures are now correctly initialized.
      Restart the Caml main thread. */
@@ -276,17 +242,10 @@ static DWORD WINAPI gr_open_graph_internal(value arg)
 
   /* Enter the message handling loop */
   while (GetMessage(&msg,NULL,0,0)) {
-    if (InspectMessages != NULL) {
-      *InspectMessages = msg;
-      SetEvent(EventHandle);
-    }
     TranslateMessage(&msg);  // Translates virtual key codes
     DispatchMessage(&msg);   // Dispatches message to window
     if (!IsWindow(grwindow.hwnd))
       break;
-    if (InspectMessages != NULL) {
-      WaitForSingleObject(EventProcessedHandle,INFINITE);
-    }
   }
   return 0;
 }
@@ -310,11 +269,8 @@ CAMLprim value caml_gr_open_graph(value arg)
 CAMLprim value caml_gr_close_graph(void)
 {
         if (gr_initialized) {
-                DeleteDC(grwindow.tempDC);
-                DeleteDC(grwindow.gcBitmap);
-                DestroyWindow(grwindow.hwnd);
-                memset(&grwindow,0,sizeof(grwindow));
-                gr_initialized = 0;
+	        PostMessage(grwindow.hwnd, WM_CLOSE, 0, 0);
+                WaitForSingleObject(threadHandle, INFINITE);
         }
         return Val_unit;
 }