From dc01ad9ff704e72449b7756ac32a99fb21f4cbfd Mon Sep 17 00:00:00 2001
From: malc <moosotc@gmail.com>
Date: Sun, 9 Aug 2015 03:24:57 +0300
Subject: [PATCH] Move cursor handling to C

Theming and such is handled outside of the protocol (in the Xlib).

Default X11 font cursors are somewhat unpretty, but here custom cursor
font was used and it was never much of a bother, things change though,
let's follow suit.

On one hand healthy -~30 lines, on the other Xlib... oh well, given
it's inevitable presence due to GLX...
---
 link.c | 16 ++++++++++++++++
 wsi.ml | 58 ++++------------------------------------------------------
 2 files changed, 20 insertions(+), 54 deletions(-)

diff --git a/link.c b/link.c
index 83f4bb6..6056e37 100644
--- a/link.c
+++ b/link.c
@@ -3805,6 +3805,7 @@ CAMLprim value ml_setaalevel (value level_v)
 #pragma GCC diagnostic push
 #pragma GCC diagnostic ignored "-Wvariadic-macros"
 #include <X11/Xlib.h>
+#include <X11/cursorfont.h>
 #pragma GCC diagnostic pop
 
 #include <GL/glx.h>
@@ -3814,12 +3815,14 @@ static struct {
     Display *dpy;
     GLXContext ctx;
     XVisualInfo *visual;
+    Cursor curs[6];
 } glx;
 
 CAMLprim value ml_glxinit (value display_v, value wid_v, value screen_v)
 {
     CAMLparam3 (display_v, wid_v, screen_v);
     int attribs[] = {GLX_RGBA,  GLX_DOUBLEBUFFER, None};
+    int shapes[] = { XC_arrow, XC_hand2, XC_exchange, XC_crosshair, XC_xterm };
 
     glx.dpy = XOpenDisplay (String_val (display_v));
     if (!glx.dpy) {
@@ -3832,6 +3835,10 @@ CAMLprim value ml_glxinit (value display_v, value wid_v, value screen_v)
         caml_failwith ("glXChooseVisual");
     }
 
+    for (size_t n = 0; n < sizeof (shapes) / sizeof (shapes[0]); ++n) {
+        glx.curs[n] = XCreateFontCursor (glx.dpy, shapes[n]);
+    }
+
     glx.wid = Int_val (wid_v);
     CAMLreturn (Val_int (glx.visual->visualid));
 }
@@ -3856,6 +3863,15 @@ CAMLprim value ml_glxcompleteinit (value unit_v)
     CAMLreturn (Val_unit);
 }
 
+CAMLprim value ml_setcursor (value cursor_v)
+{
+    CAMLparam1 (cursor_v);
+    XSetWindowAttributes wa = { .cursor = glx.curs[Int_val (cursor_v)] };
+    XChangeWindowAttributes (glx.dpy, glx.wid, CWCursor, &wa);
+    XFlush (glx.dpy);
+    CAMLreturn (Val_unit);
+}
+
 CAMLprim value ml_swapb (value unit_v)
 {
     CAMLparam1 (unit_v);
diff --git a/wsi.ml b/wsi.ml
index d85f5a7..8d63236 100644
--- a/wsi.ml
+++ b/wsi.ml
@@ -27,6 +27,7 @@ type wid = int and screenno = int and vid = int and atom = int;;
 external glxinit : string -> wid -> screenno -> vid = "ml_glxinit";;
 external glxcompleteinit : unit -> unit = "ml_glxcompleteinit";;
 external swapb : unit -> unit = "ml_swapb";;
+external setcursor : cursor -> unit = "ml_setcursor";;
 
 let vlog fmt = Format.ksprintf ignore fmt;;
 
@@ -370,40 +371,6 @@ let getpropreq delete wid prop typ =
   s;
 ;;
 
-let openfontreq fid name =
-  let s = makereq 45 12 0 in
-  let s = padcat s name in
-  w16 s 2 (Bytes.length s / 4);
-  w32 s 4 fid;
-  w16 s 8 (Bytes.length name);
-  s;
-;;
-
-let createglyphcursorreq fid cid cindex =
-  let s = makereq 94 32 8 in
-  w32 s 4 cid;
-  w32 s 8 fid;
-  w32 s 12 fid;
-  w16 s 16 cindex;
-  w16 s 18 (cindex+1);
-  w16 s 20 0;
-  w16 s 22 0;
-  w16 s 24 0;
-  w16 s 26 0xffff;
-  w16 s 28 0xffff;
-  w16 s 30 0xffff;
-  s;
-;;
-
-let changewindowattributesreq wid mask attrs =
-  let s = makereq 2 12 0 in
-  let s = padcat s attrs in
-  w16 s 2 (Bytes.length s / 4);
-  w32 s 4 wid;
-  w32 s 8 mask;
-  s;
-;;
-
 let configurewindowreq wid mask values =
   let s = makereq 12 12 0 in
   let s = padcat s values in
@@ -932,14 +899,6 @@ let setup disp sock rootwid screennum w h =
       let s = getmodifiermappingreq () in
       sendwithrep sock s (updmodmap sock);
 
-      let s = openfontreq fid (~> "cursor") in
-      sendstr s sock;
-
-      Array.iteri (fun i glyphindex ->
-        let s = createglyphcursorreq fid (fid+1+i) glyphindex in
-        sendstr s sock;
-      ) [|34;48;50;58;128;152|];
-
       sendintern sock (~> "UTF8_STRING") true (fun resp ->
         let atom = r32 resp 8 in
         if atom != 0
@@ -1220,19 +1179,10 @@ let settitle s =
 
 let setcursor cursor =
   if cursor != state.curcurs
-  then
-    let n =
-      match cursor with
-      | CURSOR_INHERIT -> -1
-      | CURSOR_INFO -> 3
-      | CURSOR_CYCLE -> 2
-      | CURSOR_CROSSHAIR -> 0
-      | CURSOR_TEXT -> 5
-    in
-    let s = s32 (if n = -1 then 0 else state.fid+1+n) in
-    let s = changewindowattributesreq state.wid 0x4000(*cursor*) s in
-    sendstr s state.sock;
+  then (
+    setcursor cursor;
     state.curcurs <- cursor;
+   )
 ;;
 
 let fullscreen () =
-- 
2.11.4.GIT