forked from KolibriOS/kolibrios
2f54c7de00
git-svn-id: svn://kolibrios.org@8097 a494cfbc-eb01-0410-851d-a64ba20cac60
293 lines
13 KiB
Plaintext
293 lines
13 KiB
Plaintext
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.
|
|
|