From 44d4fa1ab78faa571acbaf5079bca90d60101a0d Mon Sep 17 00:00:00 2001 From: "Michael D. Lowis" Date: Wed, 30 Aug 2017 14:24:31 -0400 Subject: [PATCH] x11 module can now create windows. mor work needed to access events, properties, selections, and drawing routines --- Makefile | 4 +-- edit.ml | 4 +-- lib/tide.mli | 2 +- lib/x11.ml | 25 +++++++++---- lib/x11_prims.c | 94 ++++++++++++++++++++++++++++++++++++++++++++++++- 5 files changed, 116 insertions(+), 13 deletions(-) diff --git a/Makefile b/Makefile index cf52dba..3b13f0f 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ # Toolchain Configuration #------------------------------------------------------------------------------- -INCS = -I . -I lib -I /usr/X11R6/include -LIBS = -L/usr/X11R6/lib -lX11 +INCS = -I . -I lib -I /usr/X11R6/include -I /usr/include/freetype2 +LIBS = -L/usr/X11R6/lib -lX11 -lXft ifeq ($(NATIVE), 1) OC = ocamlopt diff --git a/edit.ml b/edit.ml index d4a9c51..d21b23b 100644 --- a/edit.ml +++ b/edit.ml @@ -1,5 +1,6 @@ let () = - X11.connect (); + X11.make_window 640 480; + X11.show_window true; let server = Tide.start_server () in let nargs = Array.length Sys.argv in for i = 1 to (nargs - 1) do @@ -9,4 +10,3 @@ let () = else Tide.edit_file server arg done; - X11.disconnect () diff --git a/lib/tide.mli b/lib/tide.mli index 38486a7..51191b8 100644 --- a/lib/tide.mli +++ b/lib/tide.mli @@ -1,3 +1,3 @@ val start_server : unit -> int -val edit_file : int -> string -> unit val start_pty : int -> string array -> unit +val edit_file : int -> string -> unit diff --git a/lib/x11.ml b/lib/x11.ml index 52ef815..04e8798 100644 --- a/lib/x11.ml +++ b/lib/x11.ml @@ -1,5 +1,5 @@ type atom -type window +type winid external connect : unit -> unit = "x11_connect" @@ -7,25 +7,36 @@ external connect : unit -> unit external disconnect : unit -> unit = "x11_disconnect" +external make_window : int -> int -> unit + = "x11_make_window" + +external make_dialog : int -> int -> unit + = "x11_make_dialog" + +external show_window : bool -> unit + = "x11_show_window" + external errno : unit -> int = "x11_errno" external intern : string -> atom = "x11_intern" -external prop_set : window -> atom -> string -> unit +external prop_set : winid -> atom -> string -> unit = "x11_prop_set" -external prop_get : window -> atom -> string +external prop_get : winid -> atom -> string = "x11_prop_get" (* to be implemented -external mkwindow : int -> int -> window - = "x11_mkwindow" -external mkdialog : int -> int -> window - = "x11_mkdialog" external sel_set : atom -> string -> unit = "x11_sel_set" external sel_get : atom -> unit = "x11_sel_get" *) + +(* Automatically connect and disconnect to the display server *) +let () = + connect (); + at_exit disconnect + diff --git a/lib/x11_prims.c b/lib/x11_prims.c index f3953d3..2f7f350 100644 --- a/lib/x11_prims.c +++ b/lib/x11_prims.c @@ -4,13 +4,14 @@ #include #include //#include -//#include #include #include +#include static int error_handler(Display* disp, XErrorEvent* ev); static char* readprop(Window win, Atom prop); +static void create_window(int height, int width); static struct { Display* display; @@ -20,6 +21,15 @@ static struct { int screen; Window root; int errno; + /* assume one window per process for now */ + Window self; + XftDraw* xft; + Pixmap pixmap; + int width; + int height; + XIC xic; + XIM xim; + GC gc; } X; CAMLprim value x11_connect(void) { @@ -43,6 +53,37 @@ CAMLprim value x11_disconnect(void) { CAMLreturn(Val_unit); } +CAMLprim value x11_make_window(value height, value width) { + CAMLparam2(height, width); + create_window(Int_val(height), Int_val(width)); + CAMLreturn(Val_unit); +} + +CAMLprim value x11_make_dialog(value height, value width) { + CAMLparam2(height, width); + create_window(Int_val(height), Int_val(width)); + Atom WindowType = XInternAtom(X.display, "_NET_WM_WINDOW_TYPE", False); + Atom DialogType = XInternAtom(X.display, "_NET_WM_WINDOW_TYPE_DIALOG", False); + XChangeProperty(X.display, X.self, WindowType, XA_ATOM, 32, PropModeReplace, (unsigned char*)&DialogType, 1); + CAMLreturn(Val_unit); +} + +CAMLprim value x11_show_window(value state) { + CAMLparam1(state); + if (Bool_val(state)) { + /* simulate an initial resize and map the window */ + XConfigureEvent ce; + ce.type = ConfigureNotify; + ce.width = X.width; + ce.height = X.height; + XSendEvent(X.display, X.self, False, StructureNotifyMask, (XEvent *)&ce); + XMapWindow(X.display, X.self); + } else { + XUnmapWindow(X.display, X.self); + } + CAMLreturn(Val_unit); +} + CAMLprim value x11_errno(void) { CAMLparam0(); CAMLreturn(Val_int(X.errno)); @@ -82,3 +123,54 @@ static int error_handler(Display* disp, XErrorEvent* ev) { X.errno = ev->error_code; return 0; } + +static void create_window(int height, int width) { + /* create the main window */ + X.width = width ; + X.height = height; + XWindowAttributes wa; + XGetWindowAttributes(X.display, X.root, &wa); + X.self = XCreateSimpleWindow(X.display, X.root, + (wa.width - X.width) / 2, + (wa.height - X.height) /2, + X.width, + X.height, + 0, X.depth, + 0xffffffff // config_get_int(Color00) + ); + + /* register interest in the delete window message */ + Atom wmDeleteMessage = XInternAtom(X.display, "WM_DELETE_WINDOW", False); + XSetWMProtocols(X.display, X.self, &wmDeleteMessage, 1); + + /* setup window attributes and events */ + XSetWindowAttributes swa; + swa.backing_store = WhenMapped; + swa.bit_gravity = NorthWestGravity; + XChangeWindowAttributes(X.display, X.self, CWBackingStore|CWBitGravity, &swa); + XStoreName(X.display, X.self, "tide"); + XSelectInput(X.display, X.self, + StructureNotifyMask + | ButtonPressMask + | ButtonReleaseMask + | ButtonMotionMask + | KeyPressMask + | FocusChangeMask + | PropertyChangeMask + ); + + /* set input methods */ + if ((X.xim = XOpenIM(X.display, 0, 0, 0))) + X.xic = XCreateIC(X.xim, XNInputStyle, XIMPreeditNothing|XIMStatusNothing, + XNClientWindow, X.self, XNFocusWindow, X.self, NULL); + + /* initialize pixmap and drawing context */ + X.pixmap = XCreatePixmap(X.display, X.self, width, height, X.depth); + X.xft = XftDrawCreate(X.display, X.pixmap, X.visual, X.colormap); + + /* initialize the graphics context */ + XGCValues gcv; + gcv.foreground = WhitePixel(X.display, X.screen); + gcv.graphics_exposures = False; + X.gc = XCreateGC(X.display, X.self, GCForeground|GCGraphicsExposures, &gcv); +} -- 2.49.0