Subversion Repositories Kolibri OS

Rev

Blame | Last modification | View Log | Download | RSS feed

  1. MODULE gr;     (* connect to libX11 *)
  2. IMPORT SYSTEM, unix, out;
  3.  
  4. (*
  5. X11 documentation in:
  6. - http://tronche.com/gui/x/xlib/        an X11 reference
  7. - http://www.sbin.org/doc/Xlib          an X11 tutorial (this domain has disappeared)
  8. *)
  9.  
  10. CONST
  11.         InputOutput = 1;
  12.         StructureNotifyMask = 20000H;  (* input event mask *)
  13.         ExposureMask = 8000H; KeyPressMask = 1; KeyReleaseMask = 2;
  14.         ButtonPressMask = 4; ButtonReleaseMask = 8; (* PointerNotionMask *)
  15.         ZPixmap = 2;
  16.         Expose = 12;  (* X event type *) ConfigureNotify = 22; KeyPress = 2; ButtonPress = 4;
  17.  
  18.         EventTimeOut* = 80;    (* 0, 0, 0, 0 *)
  19.         EventResize* = 81;    (* 0, w, h, 0 *)
  20.         EventKeyPressed* = 82;    (* isPrintable, keyCode (X11 scan code), state, keySym (ASCII) *)
  21.         EventKeyReleased* = 83;    (* 0, keyCode, state, 0 *)
  22.         EventButtonPressed* = 84;    (* button, x, y, state *)
  23.         EventButtonReleased* = 85;    (* button, x, y, state *)
  24.         (* mouse button 1-5 = Left, Middle, Right, Scroll wheel up, Scroll wheel down *)
  25.  
  26.         bit64 = ORD(unix.BIT_DEPTH = 64);
  27.  
  28. TYPE EventPars* = ARRAY 5 OF INTEGER;
  29.         XEvent = RECORD
  30.                 val :ARRAY 192 OF BYTE          (* union { ..., long pad[24]; } *)
  31.                 (* val :ARRAY 48 OF CARD32; *)
  32.         END;
  33.  
  34. VAR ScreenWidth*, ScreenHeight* :INTEGER;
  35.         winWidth*, winHeight* :INTEGER; (* draw by writing to pixel buffer: *)
  36.         base*, stride* :INTEGER;                (* width, height, base ptr, stride in bytes, 32-bit RGB *)
  37.         painting :BOOLEAN;
  38.  
  39.         libX11 :INTEGER;        (* handle to dynamic library *)
  40.         XOpenDisplay :PROCEDURE [linux] (name :INTEGER) :INTEGER;
  41.         XCloseDisplay :PROCEDURE [linux] (display :INTEGER);
  42.         XSynchronize :PROCEDURE [linux] (display, onoff :INTEGER) :INTEGER;  (* return prev onoff *)
  43.         XConnectionNumber :PROCEDURE [linux] (display :INTEGER) :INTEGER;
  44.         XCreateWindow :PROCEDURE [linux] (display, parent_window, x, y, w, h, border_width, depth,
  45.                 class, visual, valuemask, attributes :INTEGER) :INTEGER;  (* Window *)
  46.         XDefaultScreen :PROCEDURE [linux] (display :INTEGER) :INTEGER;
  47.         XDefaultGC :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;  (* GC *)
  48.         XDisplayWidth :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
  49.         XDisplayHeight :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
  50.         XDefaultVisual :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;  (* visual *)
  51.         XDefaultRootWindow :PROCEDURE [linux] (display :INTEGER) :INTEGER;  (* Window *)
  52.         XDefaultDepth :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
  53.         XSelectInput :PROCEDURE [linux] (display, window, event_mask :INTEGER);
  54.         XMapWindow :PROCEDURE [linux] (display, window :INTEGER);
  55.         XNextEvent :PROCEDURE [linux] (display, XEvent_p :INTEGER);
  56.         XPending :PROCEDURE [linux] (display :INTEGER) :INTEGER;
  57.         XLookupString :PROCEDURE [linux] (key_event, buffer_return, buflen, keysym_return, status_in_out :INTEGER) :INTEGER;
  58.         XCreateImage :PROCEDURE [linux] (display, visual, depth, format, offset, data,
  59.                 width, height, bitmap_pad, bytes_per_line :INTEGER) :INTEGER; (* ptr to XImage *)
  60.         XPutImage :PROCEDURE [linux] (display, window, gc, image, sx, sy, dx, dy, w, h :INTEGER);
  61.  
  62.         display, screen, window, gc, img :INTEGER;
  63.         connectionNr :INTEGER; (* fd of X11 socket *)
  64.         readX11 :unix.fd_set;  (* used by select() timeout on X11 socket *)
  65.  
  66.  
  67. PROCEDURE getSymAdr (lib :INTEGER; name :ARRAY OF CHAR; adr :INTEGER);
  68. VAR sym :INTEGER;
  69. BEGIN
  70.         sym := unix.dlsym (lib, SYSTEM.ADR(name[0]));
  71.         IF sym = 0 THEN out.formatStr ("error: dlsym: %", name); out.nl END;
  72.         ASSERT (sym # 0);
  73.         SYSTEM.PUT (adr, sym)
  74. END getSymAdr;
  75.  
  76.  
  77. PROCEDURE init;
  78. BEGIN
  79.         display := XOpenDisplay (0);
  80.         IF display = 0 THEN out.str ("error: can not open X11 display."); out.nl; out.exit(1) END;
  81.         (* ri := XSynchronize (display, 1); *)
  82.         connectionNr := XConnectionNumber (display); ASSERT (connectionNr < unix.FD_SETSIZE);
  83.         NEW (readX11); unix.FD_ZERO(readX11); unix.FD_SET (connectionNr, readX11);
  84.         screen := XDefaultScreen (display); gc := XDefaultGC (display, screen);
  85.         ScreenWidth := XDisplayWidth (display, screen); ScreenHeight := XDisplayHeight (display, screen);
  86.         base := unix.malloc (ScreenWidth * ScreenHeight * 4);
  87.         IF base = 0 THEN
  88.                 out.formatInt2 ("error: can not allocate screen buffer % x %", ScreenWidth, ScreenHeight); out.nl; out.exit(1);
  89.         END;
  90.         stride := ScreenWidth * 4;
  91.         img := XCreateImage (display, XDefaultVisual (display, screen), XDefaultDepth (display, screen),
  92.                 ZPixmap, 0, base, ScreenWidth, ScreenHeight, 32, 0);
  93. END init;
  94.  
  95.  
  96. PROCEDURE finish*;
  97. VAR ri :INTEGER;
  98. BEGIN
  99.         IF display # 0 THEN XCloseDisplay(display); display := 0 END;
  100.         IF libX11 # 0 THEN ri := unix.dlclose (libX11); libX11 := 0 END;
  101. END finish;
  102.  
  103.  
  104. PROCEDURE createWindow* (w, h :INTEGER);
  105. VAR eventMask :INTEGER;
  106. BEGIN
  107.         IF (w > ScreenWidth) OR (h > ScreenHeight) THEN
  108.                 out.str ("error: X11.createWindow: window too large"); out.exit(1);
  109.         END;
  110.         ASSERT ((w >= 0) & (h >= 0));
  111.         window := XCreateWindow (display, XDefaultRootWindow (display), 0, 0, w, h, 0,
  112.                 XDefaultDepth (display, screen), InputOutput, XDefaultVisual (display, screen), 0, 0);
  113.         winWidth := w; winHeight := h;
  114.         eventMask := StructureNotifyMask + ExposureMask + KeyPressMask + ButtonPressMask;
  115.         XSelectInput (display, window, eventMask);
  116.         XMapWindow (display, window);
  117. END createWindow;
  118.  
  119.  
  120. PROCEDURE screenBegin*;
  121.         (* intended to enable future cooperation with iOS / MacOS *)
  122. BEGIN
  123.         ASSERT (~painting); painting := TRUE
  124. END screenBegin;
  125.  
  126.  
  127. PROCEDURE screenEnd*;
  128. BEGIN
  129.         ASSERT (painting);
  130.         XPutImage (display, window, gc, img, 0, 0, 0, 0, winWidth, winHeight);
  131.         painting := FALSE;
  132. END screenEnd;
  133.  
  134.  
  135. PROCEDURE readInt (e :XEvent; i :INTEGER) :INTEGER;
  136.         (* treat XEvent byte array as int array *)
  137. VAR n :INTEGER;
  138. BEGIN
  139.         ASSERT (i >= 0);
  140.         ASSERT (i < 48);
  141.         i := i * 4;
  142.         n := e.val[i+3]*1000000H + e.val[i+2]*10000H + e.val[i+1]*100H + e.val[i];
  143. RETURN n
  144. END readInt;
  145.  
  146.  
  147. PROCEDURE nextEvent* (msTimeOut :INTEGER; VAR ev :EventPars);
  148. VAR _type, n, ri :INTEGER;
  149.         event :XEvent;
  150.         x, y, w, h :INTEGER;
  151.         timeout :unix.timespec;
  152. BEGIN
  153. (* struct XEvent (64-bit):
  154. any:   4 type   8 serial   4 send_event   8 display   8 window   8 window
  155. expose:   40 any   4 x, y, w, h, count
  156. xconfigure:   48 any   4 x, y, w, h
  157. xkey / xbutton / xmotion:   48 any   8 sub_window   8 time_ms   4 x, y, x_root, y_root   4 state   4 keycode/button
  158. *)
  159. (* struct XEvent (32-bit):
  160. any:   4 type   4 serial   4 send_event   4 display   4 window
  161. expose:   20 any   4 x, y, w, h, count
  162. xconfigure:   24 any   4 x, y, w, h
  163. xkey / xbutton / xmotion:   24 any   4 sub_window   4 time_ms   4 x, y, x_root, y_root   4 state   4 keycode/button
  164. *)
  165.         _type := 0;
  166.         WHILE _type = 0 DO
  167.                 IF (msTimeOut > 0) & (XPending(display) = 0) THEN
  168.                         timeout.tv_sec := msTimeOut DIV 1000; timeout.tv_usec := (msTimeOut MOD 1000) * 1000;
  169.                         ri := unix.select (connectionNr + 1, readX11, NIL, NIL, timeout); ASSERT (ri # -1);
  170.                         IF ri = 0 THEN _type := EventTimeOut; ev[1] := 0; ev[2] := 0; ev[3] := 0; ev[4] := 0 END;
  171.                 END;
  172.                 IF _type = 0 THEN
  173.                         XNextEvent (display, SYSTEM.ADR(event));
  174.                         CASE readInt (event, 0) OF
  175.                         Expose :
  176.                                 x := readInt (event, 5 + 5 * bit64); y := readInt (event, 6 + 5 * bit64);
  177.                                 w := readInt (event, 7 + 5 * bit64); h := readInt (event, 8 + 5 * bit64);
  178.                                 XPutImage (display, window, gc, img, x, y, x, y, w, h);
  179.                         | ConfigureNotify :
  180.                                 w := readInt (event, 8 + 6 * bit64); h := readInt (event, 9 + 6 * bit64);
  181.                                 IF (w # winWidth) & (h # winHeight) THEN
  182.                                         ASSERT ((w >= 0) & (h >= 0));
  183.                                         IF w > ScreenWidth THEN w := ScreenWidth END;
  184.                                         IF h > ScreenHeight THEN h := ScreenHeight END;
  185.                                         winWidth := w; winHeight := h;
  186.                                         ev[0] := EventResize; ev[1] := 0; ev[2] := w; ev[3] := h; ev[4] := 0;
  187.                                 END;
  188.                         | KeyPress :
  189.                                 _type := EventKeyPressed;
  190.                                 x := XLookupString (SYSTEM.ADR(event), 0, 0, SYSTEM.ADR(n), 0);  (* KeySym *)
  191.                                 IF (n = 8) OR (n = 10) OR (n >= 32) & (n <= 126) THEN ev[1] := 1 ELSE ev[1] := 0; n := 0 END;  (* isprint *)
  192.                                 ev[2] := readInt (event, 13 + 8 * bit64); (* keycode *)
  193.                                 ev[3] := readInt (event, 12 + 8 * bit64); (* state *)
  194.                                 ev[4] := n;  (* KeySym *)
  195.                         | ButtonPress :
  196.                                 _type := EventButtonPressed;
  197.                                 ev[1] := readInt (event, 13 + 8 * bit64); (* button *)
  198.                                 ev[2] := readInt (event, 8 + 8 * bit64);  (* x *)
  199.                                 ev[3] := readInt (event, 9 + 8 * bit64);  (* y *)
  200.                                 ev[4] := readInt (event, 12 + 8 * bit64); (* state *)
  201.                         ELSE
  202.                         END
  203.                 END
  204.         END;
  205.         ev[0] := _type
  206. END nextEvent;
  207.  
  208.  
  209. PROCEDURE clear* (color :INTEGER);   (* fill window area with color *)
  210. VAR p, i, j :INTEGER;
  211. BEGIN
  212.         FOR j := 0 TO winHeight-1 DO
  213.                 p := base + j*stride;
  214.                 FOR i := 0 TO winWidth-1 DO SYSTEM.PUT32 (p, color); INC (p, 4) END
  215.         END
  216. END clear;
  217.  
  218.  
  219. (*
  220. PROCEDURE blitError (stride, x, y, w, h :INTEGER);
  221. BEGIN
  222.         o.formatInt ("error: screen.blit (src, %)", stride);
  223.         o.formatInt2 (", %, %", x, y);
  224.         o.formatInt2 (", %, %) out of bounds", w, h); o.nl;
  225.         ASSERT (FALSE)
  226. END blitError;
  227.  
  228. PROCEDURE blit* (src, srcStride, x, y, w, h :INTEGER);
  229. VAR dstStride, p :INTEGER;
  230. BEGIN
  231.         IF (x < 0) OR (y < 0) THEN blitError (srcStride, x, y, w, h) END;
  232.         IF (w <= 0) OR (h <= 0) THEN blitError (srcStride, x, y, w, h) END;
  233.         IF (x + w > ScreenWidth) OR (y + h > ScreenHeight) THEN blitError (srcStride, x, y, w, h) END;
  234.  
  235.         dstStride := ScreenWidth - w;
  236.         p := ScreenBase + y * ScreenWidth + x * 4;
  237.         REPEAT
  238.                 SYSTEM.COPY (src, p, w);
  239.                 INC (src, srcStride); INC (p, dstStride); DEC (h)
  240.         UNTIL h = 0
  241. END blit;
  242. *)
  243.  
  244. (*
  245. PROCEDURE setPixel* (x, y, color :INTEGER);
  246. VAR p :INTEGER;
  247. BEGIN
  248.         ASSERT ((x >= 0) & (x < ScreenWidth) & (y >= 0) & (y < ScreenHeight));
  249.         screenBegin; p := base + (y*ScreenWidth + x)*4; SYSTEM.PUT32 (p, color); p := p + 4 screenEnd
  250. END setPixel;
  251. *)
  252.  
  253. (*
  254. PROCEDURE loop;    (* example main loop *)
  255. VAR e :EventPars;
  256.         stop :BOOLEAN;
  257. BEGIN
  258.         createWindow (200, 200);
  259.         stop := FALSE;
  260.         REPEAT
  261.                 nextEvent (0, e);
  262.                 IF e[0] = EventKeyPressed THEN stop := TRUE END;
  263.         UNTIL stop;
  264.         XCloseDisplay (display);
  265. END loop;
  266. *)
  267.  
  268.  
  269. BEGIN
  270.         libX11 := unix.dlopen (SYSTEM.SADR("libX11.so.6"), unix.RTLD_LAZY); ASSERT (libX11 # 0);
  271.         getSymAdr (libX11, "XOpenDisplay", SYSTEM.ADR(XOpenDisplay));
  272.         getSymAdr (libX11, "XCloseDisplay", SYSTEM.ADR(XCloseDisplay));
  273.         getSymAdr (libX11, "XSynchronize", SYSTEM.ADR(XSynchronize));
  274.         getSymAdr (libX11, "XConnectionNumber", SYSTEM.ADR(XConnectionNumber));
  275.         getSymAdr (libX11, "XCreateWindow", SYSTEM.ADR(XCreateWindow));
  276.         getSymAdr (libX11, "XDefaultScreen", SYSTEM.ADR(XDefaultScreen));
  277.         getSymAdr (libX11, "XDefaultGC", SYSTEM.ADR(XDefaultGC));
  278.         getSymAdr (libX11, "XDisplayWidth", SYSTEM.ADR(XDisplayWidth));
  279.         getSymAdr (libX11, "XDisplayHeight", SYSTEM.ADR(XDisplayHeight));
  280.         getSymAdr (libX11, "XDefaultVisual", SYSTEM.ADR(XDefaultVisual));
  281.         getSymAdr (libX11, "XDefaultRootWindow", SYSTEM.ADR(XDefaultRootWindow));
  282.         getSymAdr (libX11, "XDefaultDepth", SYSTEM.ADR(XDefaultDepth));
  283.         getSymAdr (libX11, "XSelectInput", SYSTEM.ADR(XSelectInput));
  284.         getSymAdr (libX11, "XMapWindow", SYSTEM.ADR(XMapWindow));
  285.         getSymAdr (libX11, "XNextEvent", SYSTEM.ADR(XNextEvent));
  286.         getSymAdr (libX11, "XPending", SYSTEM.ADR(XPending));
  287.         getSymAdr (libX11, "XLookupString", SYSTEM.ADR(XLookupString));
  288.         getSymAdr (libX11, "XCreateImage", SYSTEM.ADR(XCreateImage));
  289.         getSymAdr (libX11, "XPutImage", SYSTEM.ADR(XPutImage));
  290.         init;
  291. END gr.
  292.  
  293.