Mouse buttons

examples/dune

@@ -1,3 +1,3 @@
 (executables
- (names graph_example graph_test sorts)
+ (names graph_example graph_test sorts test_mouse_buttons)
  (libraries graphics threads))

examples/test_mouse_buttons.ml

@@ -0,0 +1,16 @@
+open Graphics;;
+
+open_graph "";;
+
+try
+  while true do
+    let st = wait_next_event [ Button_down; Button_up; Key_pressed ] in
+    if st.keypressed then raise Exit;
+    List.iter
+      (fun (b,v) ->
+        Printf.printf "button %i %s\n" b (if v then "vrai" else "faux"))
+      [ (1, st.button1); (2, st.button2); (3, st.button3);
+        (4, st.button4); (5, st.button5) ];
+    print_newline()
+  done
+with Exit -> ()

src/graphics.ml

@@ -228,6 +228,11 @@ type status = {
   mouse_x : int;
   mouse_y : int;
   button : bool;
+  button1 : bool;
+  button2 : bool;
+  button3 : bool;
+  button4 : bool;
+  button5 : bool;
   keypressed : bool;
   key : char;
 }
@@ -244,6 +249,15 @@ let button_down () =
   let e = wait_next_event [ Poll ] in
   e.button
 
+let button_down_n n =
+  let e = wait_next_event [ Poll ] in match n with
+  | 1 -> e.button1
+  | 2 -> e.button2
+  | 3 -> e.button3
+  | 4 -> e.button4
+  | 5 -> e.button5
+  | _ -> failwith "bad button number"
+
 let read_key () =
   let e = wait_next_event [ Key_pressed ] in
   e.key

src/graphics.mli

@@ -287,6 +287,11 @@ 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 *)
+  button1 : bool; (** true if mouse button 1 is pressed *)
+  button2 : bool; (** true if mouse button 2 is pressed *)
+  button3 : bool; (** true if mouse button 3 is pressed *)
+  button4 : bool; (** true if mouse button 4 is pressed *)
+  button5 : bool; (** true if mouse button 5 is pressed *)
   keypressed : bool;  (** true if a key has been pressed *)
   key : char;  (** the character for the key pressed *)
 }
@@ -327,7 +332,10 @@ val mouse_pos : unit -> int * int
    [0..size_x()-1, 0..size_y()-1]. *)
 
 val button_down : unit -> bool
-(** Return [true] if the mouse button is pressed, [false] otherwise. *)
+(** Return [true] if a mouse button is pressed, [false] otherwise. *)
+
+val button_down_n : int -> bool
+(** Return [true] if this mouse button is pressed, [false] otherwise. *)
 
 val read_key : unit -> char
 (** Wait for a key to be pressed, and return the corresponding

src/unix/events.c

@@ -49,15 +49,15 @@ static void caml_gr_enqueue_event(int kind, int mouse_x, int mouse_y,
   ev->kind = kind;
   ev->mouse_x = mouse_x;
   ev->mouse_y = mouse_y;
-  ev->button = (button != 0);
+  ev->button = (unsigned char) button;
   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;
 }
 
 #define BUTTON_STATE(state) \
-  ((state) & (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask))
+  ((state) & (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask)) >> 8
 
 void caml_gr_handle_event(XEvent * event)
 {
@@ -131,9 +131,14 @@ void caml_gr_handle_event(XEvent * event)
     }
 
   case ButtonPress:
+    caml_gr_enqueue_event(event->type, event->xbutton.x, event->xbutton.y,
+			  BUTTON_STATE(event->xbutton.state)
+			  | 1<<(event->xbutton.button-1),0);
+    break;
   case ButtonRelease:
     caml_gr_enqueue_event(event->type, event->xbutton.x, event->xbutton.y,
-                     event->type == ButtonPress, 0);
+			  BUTTON_STATE(event->xbutton.state)
+			  & ~(1 << (event->xbutton.button-1)), 0);
     break;
 
   case MotionNotify:
@@ -146,12 +151,17 @@ void caml_gr_handle_event(XEvent * event)
 static value caml_gr_wait_allocate_result(int mouse_x, int mouse_y, int button,
                                      int keypressed, int key)
 {
-  value res = caml_alloc_small(5, 0);
+  value res = caml_alloc_small(10, 0);
   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(keypressed);
-  Field(res, 4) = Val_int(key & 0xFF);
+  Field(res, 3) = Val_bool(button & 1);
+  Field(res, 4) = Val_bool(button & 2);
+  Field(res, 5) = Val_bool(button & 4);
+  Field(res, 6) = Val_bool(button & 8);
+  Field(res, 7) = Val_bool(button & 16);
+  Field(res, 8) = Val_bool(keypressed);
+  Field(res, 9) = Val_int(key & 0xFF);
   return res;
 }
 

src/win32/events.c

@@ -65,7 +65,7 @@ static void caml_gr_enqueue_event(int kind, LPARAM mouse_xy,
   ev->kind = kind;
   ev->mouse_x = GET_X_LPARAM(mouse_xy);
   ev->mouse_y = GET_Y_LPARAM(mouse_xy);
-  ev->button = (button != 0);
+  ev->button = (unsigned char) button;
   ev->key = key;
   caml_gr_tail = (caml_gr_tail + 1) % SIZE_QUEUE;
   /* If queue was full, it now appears empty;
@@ -85,17 +85,19 @@ void caml_gr_handle_event(UINT msg, WPARAM wParam, LPARAM lParam)
   case WM_LBUTTONDOWN:
   case WM_RBUTTONDOWN:
   case WM_MBUTTONDOWN:
-    last_button = 1;
+    last_button |= (msg==WM_LBUTTONDOWN?~1:
+		    msg==WM_RBUTTONDOWN?~4:2);
     last_pos = lParam;
-    caml_gr_enqueue_event(EVENT_BUTTON_DOWN, lParam, 1, 0);
+    caml_gr_enqueue_event(EVENT_BUTTON_DOWN, lParam, last_button, 0);
     break;
 
   case WM_LBUTTONUP:
   case WM_RBUTTONUP:
   case WM_MBUTTONUP:
-    last_button = 0;
+    last_button &= (msg==WM_LBUTTONUP?~1:
+		    msg==WM_RBUTTONUP?~4:2);
     last_pos = lParam;
-    caml_gr_enqueue_event(EVENT_BUTTON_UP, lParam, 0, 0);
+    caml_gr_enqueue_event(EVENT_BUTTON_UP, lParam, last_button, 0);
     break;
 
   case WM_CHAR:
@@ -117,12 +119,17 @@ static value caml_gr_wait_allocate_result(int mouse_x, int mouse_y,
                                           int button,
                                           int keypressed, int key)
 {
-  value res = caml_alloc_small(5, 0);
+  value res = caml_alloc_small(10, 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);
+  Field(res, 3) = Val_bool(button & 1);
+  Field(res, 4) = Val_bool(button & 2);
+  Field(res, 5) = Val_bool(button & 4);
+  Field(res, 6) = Val_bool(button & 8);
+  Field(res, 7) = Val_bool(button & 16);
+  Field(res, 8) = Val_bool(keypressed);
+  Field(res, 9) = Val_int(key & 0xFF);
   return res;
 }