ruberon/samples/linux/x11/common/gr.ob07

MODULE gr;     (* connect to libX11 *)
IMPORT SYSTEM, unix, out;

(*
X11 documentation in:
- http://tronche.com/gui/x/xlib/        an X11 reference
- http://www.sbin.org/doc/Xlib          an X11 tutorial (this domain has disappeared)
*)

CONST
        InputOutput = 1;
        StructureNotifyMask = 20000H;  (* input event mask *)
        ExposureMask = 8000H; KeyPressMask = 1; KeyReleaseMask = 2;
        ButtonPressMask = 4; ButtonReleaseMask = 8; (* PointerNotionMask *)
        ZPixmap = 2;
        Expose = 12;  (* X event type *) ConfigureNotify = 22; KeyPress = 2; ButtonPress = 4;

        EventTimeOut* = 80;    (* 0, 0, 0, 0 *)
        EventResize* = 81;    (* 0, w, h, 0 *)
        EventKeyPressed* = 82;    (* isPrintable, keyCode (X11 scan code), state, keySym (ASCII) *)
        EventKeyReleased* = 83;    (* 0, keyCode, state, 0 *)
        EventButtonPressed* = 84;    (* button, x, y, state *)
        EventButtonReleased* = 85;    (* button, x, y, state *)
        (* mouse button 1-5 = Left, Middle, Right, Scroll wheel up, Scroll wheel down *)

        bit64 = ORD(unix.BIT_DEPTH = 64);

TYPE EventPars* = ARRAY 5 OF INTEGER;
        XEvent = RECORD
                val :ARRAY 192 OF BYTE          (* union { ..., long pad[24]; } *)
                (* val :ARRAY 48 OF CARD32; *)
        END;

VAR ScreenWidth*, ScreenHeight* :INTEGER;
        winWidth*, winHeight* :INTEGER; (* draw by writing to pixel buffer: *)
        base*, stride* :INTEGER;                (* width, height, base ptr, stride in bytes, 32-bit RGB *)
        painting :BOOLEAN;

        libX11 :INTEGER;        (* handle to dynamic library *)
        XOpenDisplay :PROCEDURE [linux] (name :INTEGER) :INTEGER;
        XCloseDisplay :PROCEDURE [linux] (display :INTEGER);
        XSynchronize :PROCEDURE [linux] (display, onoff :INTEGER) :INTEGER;  (* return prev onoff *)
        XConnectionNumber :PROCEDURE [linux] (display :INTEGER) :INTEGER;
        XCreateWindow :PROCEDURE [linux] (display, parent_window, x, y, w, h, border_width, depth,
                class, visual, valuemask, attributes :INTEGER) :INTEGER;  (* Window *)
        XDefaultScreen :PROCEDURE [linux] (display :INTEGER) :INTEGER;
        XDefaultGC :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;  (* GC *)
        XDisplayWidth :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
        XDisplayHeight :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
        XDefaultVisual :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;  (* visual *)
        XDefaultRootWindow :PROCEDURE [linux] (display :INTEGER) :INTEGER;  (* Window *)
        XDefaultDepth :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
        XSelectInput :PROCEDURE [linux] (display, window, event_mask :INTEGER);
        XMapWindow :PROCEDURE [linux] (display, window :INTEGER);
        XNextEvent :PROCEDURE [linux] (display, XEvent_p :INTEGER);
        XPending :PROCEDURE [linux] (display :INTEGER) :INTEGER;
        XLookupString :PROCEDURE [linux] (key_event, buffer_return, buflen, keysym_return, status_in_out :INTEGER) :INTEGER;
        XCreateImage :PROCEDURE [linux] (display, visual, depth, format, offset, data,
                width, height, bitmap_pad, bytes_per_line :INTEGER) :INTEGER; (* ptr to XImage *)
        XPutImage :PROCEDURE [linux] (display, window, gc, image, sx, sy, dx, dy, w, h :INTEGER);

        display, screen, window, gc, img :INTEGER;
        connectionNr :INTEGER; (* fd of X11 socket *)
        readX11 :unix.fd_set;  (* used by select() timeout on X11 socket *)


PROCEDURE getSymAdr (lib :INTEGER; name :ARRAY OF CHAR; adr :INTEGER);
VAR sym :INTEGER;
BEGIN
        sym := unix.dlsym (lib, SYSTEM.ADR(name[0]));
        IF sym = 0 THEN out.formatStr ("error: dlsym: %", name); out.nl END;
        ASSERT (sym # 0);
        SYSTEM.PUT (adr, sym)
END getSymAdr;


PROCEDURE init;
BEGIN
        display := XOpenDisplay (0);
        IF display = 0 THEN out.str ("error: can not open X11 display."); out.nl; out.exit(1) END;
        (* ri := XSynchronize (display, 1); *)
        connectionNr := XConnectionNumber (display); ASSERT (connectionNr < unix.FD_SETSIZE);
        NEW (readX11); unix.FD_ZERO(readX11); unix.FD_SET (connectionNr, readX11);
        screen := XDefaultScreen (display); gc := XDefaultGC (display, screen);
        ScreenWidth := XDisplayWidth (display, screen); ScreenHeight := XDisplayHeight (display, screen);
        base := unix.malloc (ScreenWidth * ScreenHeight * 4);
        IF base = 0 THEN
                out.formatInt2 ("error: can not allocate screen buffer % x %", ScreenWidth, ScreenHeight); out.nl; out.exit(1);
        END;
        stride := ScreenWidth * 4;
        img := XCreateImage (display, XDefaultVisual (display, screen), XDefaultDepth (display, screen),
                ZPixmap, 0, base, ScreenWidth, ScreenHeight, 32, 0);
END init;


PROCEDURE finish*;
VAR ri :INTEGER;
BEGIN
        IF display # 0 THEN XCloseDisplay(display); display := 0 END;
        IF libX11 # 0 THEN ri := unix.dlclose (libX11); libX11 := 0 END;
END finish;


PROCEDURE createWindow* (w, h :INTEGER);
VAR eventMask :INTEGER;
BEGIN
        IF (w > ScreenWidth) OR (h > ScreenHeight) THEN
                out.str ("error: X11.createWindow: window too large"); out.exit(1);
        END;
        ASSERT ((w >= 0) & (h >= 0));
        window := XCreateWindow (display, XDefaultRootWindow (display), 0, 0, w, h, 0,
                XDefaultDepth (display, screen), InputOutput, XDefaultVisual (display, screen), 0, 0);
        winWidth := w; winHeight := h;
        eventMask := StructureNotifyMask + ExposureMask + KeyPressMask + ButtonPressMask;
        XSelectInput (display, window, eventMask);
        XMapWindow (display, window);
END createWindow;


PROCEDURE screenBegin*;
        (* intended to enable future cooperation with iOS / MacOS *)
BEGIN
        ASSERT (~painting); painting := TRUE
END screenBegin;


PROCEDURE screenEnd*;
BEGIN
        ASSERT (painting);
        XPutImage (display, window, gc, img, 0, 0, 0, 0, winWidth, winHeight);
        painting := FALSE;
END screenEnd;


PROCEDURE readInt (e :XEvent; i :INTEGER) :INTEGER;
        (* treat XEvent byte array as int array *)
VAR n :INTEGER;
BEGIN
        ASSERT (i >= 0);
        ASSERT (i < 48);
        i := i * 4;
        n := e.val[i+3]*1000000H + e.val[i+2]*10000H + e.val[i+1]*100H + e.val[i];
RETURN n
END readInt;


PROCEDURE nextEvent* (msTimeOut :INTEGER; VAR ev :EventPars);
VAR _type, n, ri :INTEGER;
        event :XEvent;
        x, y, w, h :INTEGER;
        timeout :unix.timespec;
BEGIN
(* struct XEvent (64-bit):
any:   4 type   8 serial   4 send_event   8 display   8 window   8 window
expose:   40 any   4 x, y, w, h, count
xconfigure:   48 any   4 x, y, w, h
xkey / xbutton / xmotion:   48 any   8 sub_window   8 time_ms   4 x, y, x_root, y_root   4 state   4 keycode/button
*)
(* struct XEvent (32-bit):
any:   4 type   4 serial   4 send_event   4 display   4 window
expose:   20 any   4 x, y, w, h, count
xconfigure:   24 any   4 x, y, w, h
xkey / xbutton / xmotion:   24 any   4 sub_window   4 time_ms   4 x, y, x_root, y_root   4 state   4 keycode/button
*)
        _type := 0;
        WHILE _type = 0 DO
                IF (msTimeOut > 0) & (XPending(display) = 0) THEN
                        timeout.tv_sec := msTimeOut DIV 1000; timeout.tv_usec := (msTimeOut MOD 1000) * 1000;
                        ri := unix.select (connectionNr + 1, readX11, NIL, NIL, timeout); ASSERT (ri # -1);
                        IF ri = 0 THEN _type := EventTimeOut; ev[1] := 0; ev[2] := 0; ev[3] := 0; ev[4] := 0 END;
                END;
                IF _type = 0 THEN
                        XNextEvent (display, SYSTEM.ADR(event));
                        CASE readInt (event, 0) OF
                        Expose :
                                x := readInt (event, 5 + 5 * bit64); y := readInt (event, 6 + 5 * bit64);
                                w := readInt (event, 7 + 5 * bit64); h := readInt (event, 8 + 5 * bit64);
                                XPutImage (display, window, gc, img, x, y, x, y, w, h);
                        | ConfigureNotify :
                                w := readInt (event, 8 + 6 * bit64); h := readInt (event, 9 + 6 * bit64);
                                IF (w # winWidth) & (h # winHeight) THEN
                                        ASSERT ((w >= 0) & (h >= 0));
                                        IF w > ScreenWidth THEN w := ScreenWidth END;
                                        IF h > ScreenHeight THEN h := ScreenHeight END;
                                        winWidth := w; winHeight := h;
                                        ev[0] := EventResize; ev[1] := 0; ev[2] := w; ev[3] := h; ev[4] := 0;
                                END;
                        | KeyPress :
                                _type := EventKeyPressed;
                                x := XLookupString (SYSTEM.ADR(event), 0, 0, SYSTEM.ADR(n), 0);  (* KeySym *)
                                IF (n = 8) OR (n = 10) OR (n >= 32) & (n <= 126) THEN ev[1] := 1 ELSE ev[1] := 0; n := 0 END;  (* isprint *)
                                ev[2] := readInt (event, 13 + 8 * bit64); (* keycode *)
                                ev[3] := readInt (event, 12 + 8 * bit64); (* state *)
                                ev[4] := n;  (* KeySym *)
                        | ButtonPress :
                                _type := EventButtonPressed;
                                ev[1] := readInt (event, 13 + 8 * bit64); (* button *)
                                ev[2] := readInt (event, 8 + 8 * bit64);  (* x *)
                                ev[3] := readInt (event, 9 + 8 * bit64);  (* y *)
                                ev[4] := readInt (event, 12 + 8 * bit64); (* state *)
                        ELSE
                        END
                END
        END;
        ev[0] := _type
END nextEvent;


PROCEDURE clear* (color :INTEGER);   (* fill window area with color *)
VAR p, i, j :INTEGER;
BEGIN
        FOR j := 0 TO winHeight-1 DO
                p := base + j*stride;
                FOR i := 0 TO winWidth-1 DO SYSTEM.PUT32 (p, color); INC (p, 4) END
        END
END clear;


(*
PROCEDURE blitError (stride, x, y, w, h :INTEGER);
BEGIN
        o.formatInt ("error: screen.blit (src, %)", stride);
        o.formatInt2 (", %, %", x, y);
        o.formatInt2 (", %, %) out of bounds", w, h); o.nl;
        ASSERT (FALSE)
END blitError;

PROCEDURE blit* (src, srcStride, x, y, w, h :INTEGER);
VAR dstStride, p :INTEGER;
BEGIN
        IF (x < 0) OR (y < 0) THEN blitError (srcStride, x, y, w, h) END;
        IF (w <= 0) OR (h <= 0) THEN blitError (srcStride, x, y, w, h) END;
        IF (x + w > ScreenWidth) OR (y + h > ScreenHeight) THEN blitError (srcStride, x, y, w, h) END;

        dstStride := ScreenWidth - w;
        p := ScreenBase + y * ScreenWidth + x * 4;
        REPEAT
                SYSTEM.COPY (src, p, w);
                INC (src, srcStride); INC (p, dstStride); DEC (h)
        UNTIL h = 0
END blit;
*)

(*
PROCEDURE setPixel* (x, y, color :INTEGER);
VAR p :INTEGER;
BEGIN
        ASSERT ((x >= 0) & (x < ScreenWidth) & (y >= 0) & (y < ScreenHeight));
        screenBegin; p := base + (y*ScreenWidth + x)*4; SYSTEM.PUT32 (p, color); p := p + 4 screenEnd
END setPixel;
*)

(*
PROCEDURE loop;    (* example main loop *)
VAR e :EventPars;
        stop :BOOLEAN;
BEGIN
        createWindow (200, 200);
        stop := FALSE;
        REPEAT
                nextEvent (0, e);
                IF e[0] = EventKeyPressed THEN stop := TRUE END;
        UNTIL stop;
        XCloseDisplay (display);
END loop;
*)


BEGIN
        libX11 := unix.dlopen (SYSTEM.SADR("libX11.so.6"), unix.RTLD_LAZY); ASSERT (libX11 # 0);
        getSymAdr (libX11, "XOpenDisplay", SYSTEM.ADR(XOpenDisplay));
        getSymAdr (libX11, "XCloseDisplay", SYSTEM.ADR(XCloseDisplay));
        getSymAdr (libX11, "XSynchronize", SYSTEM.ADR(XSynchronize));
        getSymAdr (libX11, "XConnectionNumber", SYSTEM.ADR(XConnectionNumber));
        getSymAdr (libX11, "XCreateWindow", SYSTEM.ADR(XCreateWindow));
        getSymAdr (libX11, "XDefaultScreen", SYSTEM.ADR(XDefaultScreen));
        getSymAdr (libX11, "XDefaultGC", SYSTEM.ADR(XDefaultGC));
        getSymAdr (libX11, "XDisplayWidth", SYSTEM.ADR(XDisplayWidth));
        getSymAdr (libX11, "XDisplayHeight", SYSTEM.ADR(XDisplayHeight));
        getSymAdr (libX11, "XDefaultVisual", SYSTEM.ADR(XDefaultVisual));
        getSymAdr (libX11, "XDefaultRootWindow", SYSTEM.ADR(XDefaultRootWindow));
        getSymAdr (libX11, "XDefaultDepth", SYSTEM.ADR(XDefaultDepth));
        getSymAdr (libX11, "XSelectInput", SYSTEM.ADR(XSelectInput));
        getSymAdr (libX11, "XMapWindow", SYSTEM.ADR(XMapWindow));
        getSymAdr (libX11, "XNextEvent", SYSTEM.ADR(XNextEvent));
        getSymAdr (libX11, "XPending", SYSTEM.ADR(XPending));
        getSymAdr (libX11, "XLookupString", SYSTEM.ADR(XLookupString));
        getSymAdr (libX11, "XCreateImage", SYSTEM.ADR(XCreateImage));
        getSymAdr (libX11, "XPutImage", SYSTEM.ADR(XPutImage));
        init;
END gr.