Go to most recent revision | Details | Last modification | View Log | RSS feed
| Rev | Author | Line No. | Line |
|---|---|---|---|
| 8097 | maxcodehac | 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 |