kolibrios-gitea/programs/develop/oberon07/Samples/Linux/X11/filler/gr.ob07
maxcodehack 2f54c7de00 Update oberon07 from akron1's github
git-svn-id: svn://kolibrios.org@8097 a494cfbc-eb01-0410-851d-a64ba20cac60
2020-10-13 07:58:51 +00:00

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.