/programs/develop/oberon07/Samples/Linux/X11/animation/_unix.ob07 |
---|
0,0 → 1,74 |
MODULE _unix; (* connect to unix host *) |
IMPORT SYSTEM, API; |
(* how to find C declarations: |
- gcc -E preprocess only (to stdout) (preprocessor expand) |
- grep -r name /usr/include/* |
- ldd progfile |
- objdump -T progfile (-t) (-x) |
*) |
CONST RTLD_LAZY = 1; |
BIT_DEPTH* = API.BIT_DEPTH; |
VAR sym, libc, libdl :INTEGER; |
_dlopen* :PROCEDURE [linux] (name, flags :INTEGER) :INTEGER; |
_dlsym* :PROCEDURE [linux] (p, name :INTEGER) :INTEGER; |
_dlclose* :PROCEDURE [linux] (p :INTEGER) :INTEGER; |
_open* :PROCEDURE [linux] (name, flags, mode :INTEGER) :INTEGER; |
_close* :PROCEDURE [linux] (fd :INTEGER) :INTEGER; |
_read* :PROCEDURE [linux] (fd, buf, sz :INTEGER): INTEGER; |
_write* :PROCEDURE [linux] (fd, buf, sz :INTEGER) :INTEGER; |
_exit* :PROCEDURE [linux] (n :INTEGER); |
_malloc* :PROCEDURE [linux] (sz :INTEGER) :INTEGER; |
_select* :PROCEDURE [linux] (cnt, readfds, writefds, exceptfds, timeout :INTEGER) :INTEGER; |
(* error message to stderr *) |
PROCEDURE writeChar (c :CHAR); |
VAR ri :INTEGER; |
BEGIN ri := _write (2, SYSTEM.ADR(c), 1); ASSERT (ri = 1) END writeChar; |
PROCEDURE writeString (s :ARRAY OF CHAR); |
VAR i :INTEGER; |
BEGIN i := 0; WHILE s[i] # 0X DO writeChar (s[i]); INC(i) END; END writeString; |
PROCEDURE nl; |
BEGIN writeChar (0AX) END nl; |
PROCEDURE getSymAdr (lib :INTEGER; name :ARRAY OF CHAR; adr :INTEGER); |
BEGIN |
sym := _dlsym (lib, SYSTEM.ADR(name[0])); |
IF sym = 0 THEN writeString ("error: dlsym: "); writeString (name); nl END; |
ASSERT (sym # 0); |
SYSTEM.PUT (adr, sym) |
END getSymAdr; |
PROCEDURE finish*; |
VAR ri :INTEGER; |
BEGIN |
IF libc # 0 THEN ri := _dlclose (libc); libc := 0 END; |
IF libdl # 0 THEN ri := _dlclose (libdl); libdl := 0 END; |
END finish; |
BEGIN |
_dlopen := API.dlopen; |
_dlsym := API.dlsym; |
libc := _dlopen (SYSTEM.SADR("libc.so.6"), RTLD_LAZY); ASSERT (libc # 0); |
(* getSymAdr is not used for write() to get writeString() error message going *); |
sym := _dlsym (libc, SYSTEM.SADR("write")); ASSERT (sym # 0); SYSTEM.PUT (SYSTEM.ADR(_write), sym); |
libdl := _dlopen (SYSTEM.SADR("libdl.so.2"), RTLD_LAZY); ASSERT (libdl # 0); |
getSymAdr (libdl, "dlclose", SYSTEM.ADR(_dlclose)); |
getSymAdr (libc, "open", SYSTEM.ADR(_open)); |
getSymAdr (libc, "close", SYSTEM.ADR(_close)); |
getSymAdr (libc, "read", SYSTEM.ADR(_read)); |
getSymAdr (libc, "exit", SYSTEM.ADR(_exit)); |
getSymAdr (libc, "malloc", SYSTEM.ADR(_malloc)); |
getSymAdr (libc, "select", SYSTEM.ADR(_select)); |
END _unix. |
/programs/develop/oberon07/Samples/Linux/X11/animation/animation.ob07 |
---|
0,0 → 1,89 |
MODULE animation; (* moving turtle example *) |
(* demonstrates use of timeout and select() to display a moving turtle in an X11 window *) |
IMPORT SYSTEM, gr; |
CONST |
Side = 8; (* nr of pixels of a square side *) |
VAR base, stride, screenBufSize :INTEGER; |
currentX :INTEGER; |
PROCEDURE drawSquare (x, y, color :INTEGER); |
VAR p, i, j :INTEGER; |
BEGIN |
p := (y*stride + x*4)*Side; |
ASSERT (p + (Side-1)*stride + (Side-1)*4 <= screenBufSize); |
p := base + p; |
FOR j := 0 TO Side-1 DO |
FOR i := 0 TO Side-1 DO SYSTEM.PUT32 (p, color); INC(p, 4) END; |
p := p + stride - Side*4; |
END; |
END drawSquare; |
PROCEDURE putLine (x : INTEGER; y: INTEGER;str : ARRAY OF CHAR); |
VAR z, x1: INTEGER; |
BEGIN |
FOR z := 0 TO LEN(str) - 1 DO |
x1 := (x + z) MOD 100; |
IF str[z] = "b" THEN drawSquare(x1, y, 0600000H); END; (* brown *) |
IF str[z] = "g" THEN drawSquare(x1, y, 000C000H); END; (* green *) |
END; |
END putLine; |
PROCEDURE turtlePicture (x , y : INTEGER); |
BEGIN |
putLine(x, y + 0 , "....bb........"); |
putLine(x, y + 1 , "....bbb......."); |
putLine(x, y + 2 , "....bbbb......"); |
putLine(x, y + 3 , ".bb..bbb......"); |
putLine(x, y + 4 , ".bgggbbbgbbgb."); |
putLine(x, y + 5 , ".ggggggggbbbb."); |
putLine(x, y + 6 , "bggggggggbbbb."); |
putLine(x, y + 7 , ".ggggggg......"); |
putLine(x, y + 8 , ".bb..bbb......"); |
putLine(x, y + 9 , "....bbbb......"); |
putLine(x, y + 10, ".....bbb......"); |
putLine(x, y + 11, ".....bb.......") |
END turtlePicture; |
PROCEDURE drawAll; |
BEGIN |
gr.screenBegin; |
gr.clear (0C0F0FFH); (* light blue *) |
turtlePicture (currentX, 15); |
gr.screenEnd; |
END drawAll; |
PROCEDURE run*; |
VAR stop :BOOLEAN; |
ev :gr.EventPars; |
ch :CHAR; |
BEGIN |
base := gr.base; stride := gr.stride; |
gr.createWindow (800, 480); |
screenBufSize := gr.winHeight * stride; |
stop := FALSE; currentX := 15; |
drawAll; |
REPEAT |
gr.nextEvent (400, ev); |
IF ev[0] = gr.EventTimeOut THEN |
drawAll; |
INC (currentX, 4); |
ELSIF ev[0] = gr.EventKeyPressed THEN |
ch := CHR(ev[4]); |
IF (ch = "q") OR (ch = 0AX) OR (ch = " ") THEN stop := TRUE END; |
IF ev[2] = 9 (* ESC *) THEN stop := TRUE END; |
END; |
UNTIL stop; |
gr.finish; |
END run; |
BEGIN |
run; |
END animation. |
/programs/develop/oberon07/Samples/Linux/X11/animation/gr.ob07 |
---|
0,0 → 1,292 |
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. |
/programs/develop/oberon07/Samples/Linux/X11/animation/out.ob07 |
---|
0,0 → 1,142 |
MODULE out; (* formatted output to stdout *) |
(* Wim Niemann, Jan Tuitman 06-OCT-2016 *) |
IMPORT SYSTEM, _unix; |
(* example: IMPORT o:=out; |
o.str("Hello, World!");o.nl; |
o.formatInt("n = %", 3);o.nl; |
*) |
(* |
The output functions buffer the characters in buf. This buffer is flushed when out.nl is |
called and also when the buffer is full. |
Calling flush once per line is far more efficient then one system call per |
character, but this is noticable only at very long outputs. |
*) |
CONST MAX = 63; (* last position in buf *) |
VAR len :INTEGER; (* string length in buf *) |
buf :ARRAY MAX+1 OF BYTE; |
PROCEDURE exit* (n :INTEGER); |
(* prevent IMPORT unix for many programs *) |
BEGIN _unix._exit(n) END exit; |
PROCEDURE writeChars; |
(* write buf to the output function and set to empty string *) |
VAR ri :INTEGER; |
BEGIN |
IF len > 0 THEN |
(* buf[len] := 0X; *) |
ri := _unix._write (1, SYSTEM.ADR(buf), len); ASSERT (ri = len); (* stdout *) |
len := 0 |
END |
END writeChars; |
PROCEDURE nl*; (* append a newline to buf and flush *) |
BEGIN |
IF len = MAX THEN writeChars END; |
buf[len] := 0AH; INC(len); |
(* unix: 0AX; Oberon: 0DX; |
Windows: IF len >= MAX-1 THEN 0DX 0AX; *) |
writeChars; |
END nl; |
PROCEDURE char* (c :CHAR); |
(* append char to the end of buf *) |
BEGIN |
IF len = MAX THEN writeChars END; |
buf[len] := ORD(c); INC(len) |
END char; |
PROCEDURE str* (t :ARRAY OF CHAR); |
(* append t to buf *) |
VAR j :INTEGER; |
BEGIN |
j := 0; WHILE t[j] # 0X DO char(t[j]); INC(j) END |
END str; |
PROCEDURE int* (n :INTEGER); |
(* append integer; append n to d, return TRUE on overflow of d *) |
VAR j :INTEGER; |
sign :BOOLEAN; |
dig :ARRAY 11 OF CHAR; (* assume 32 bit INTEGER *) |
BEGIN |
sign := FALSE; IF n < 0 THEN sign := TRUE; n := -n END; |
IF n < 0 THEN |
str ("-2147483648"); |
ELSE |
j := 0; |
REPEAT dig[j] := CHR (n MOD 10 + 30H); n := n DIV 10; INC(j) UNTIL n = 0; |
IF sign THEN char ("-") END; |
REPEAT DEC(j); char(dig[j]) UNTIL j = 0; |
END |
END int; |
PROCEDURE formatInt* (t :ARRAY OF CHAR; n :INTEGER); |
(* append formatted string t. Replace the first % by n *) |
VAR j :INTEGER; |
BEGIN |
j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END; |
IF t[j] = "%" THEN |
int(n); INC(j); |
WHILE t[j] # 0X DO char(t[j]); INC(j) END |
END |
END formatInt; |
PROCEDURE formatInt2* (t:ARRAY OF CHAR; n1, n2 :INTEGER); |
(* append formatted string t. Replace the first two % by n1 and n2 *) |
VAR j :INTEGER; |
BEGIN |
j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END; |
IF t[j] = "%" THEN |
int(n1); INC(j); |
WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END; |
IF t[j] = "%" THEN |
int(n2); INC(j); |
WHILE t[j] # 0X DO char(t[j]); INC(j) END |
END |
END |
END formatInt2; |
PROCEDURE formatStr* (t, u :ARRAY OF CHAR); |
(* append formatted string. Replace the first % in t by u *) |
VAR j, k :INTEGER; |
BEGIN |
j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END; |
IF t[j] = "%" THEN |
k := 0; WHILE u[k] # 0X DO char(u[k]); INC(k) END; |
INC(j); WHILE t[j] # 0X DO char(t[j]); INC(j) END |
END |
END formatStr; |
PROCEDURE hex* (n, width :INTEGER); |
(* print width positions of n as hex string. If necessary, prefix with leading zeroes *) |
(* note: if n needs more positions than width, the first hex digits are not printed *) |
VAR j :INTEGER; |
dig :ARRAY 9 OF CHAR; |
BEGIN |
ASSERT(width > 0); |
ASSERT (width <= 8); |
dig[width] := 0X; |
REPEAT |
j := n MOD 16; n := n DIV 16; |
IF j < 10 THEN j := ORD("0") + j ELSE j := ORD("A") + j - 10 END; |
DEC(width); dig[width] := CHR(j) |
UNTIL width = 0; |
str (dig); |
END hex; |
PROCEDURE flush*; |
(* this routine comes at the end. It won't hardly ever be called |
because nl also flushes. It is present only in case you |
want to write a flushed string which does not end with nl. *) |
BEGIN writeChars END flush; |
(* note: global variable 'len' must be 0 on init. Within the core, bodies of imported modules |
are not executed, so rely on zero initialisation by Modules.Load *) |
END out. |
/programs/develop/oberon07/Samples/Linux/X11/animation/unix.ob07 |
---|
0,0 → 1,74 |
MODULE unix; (* connect to unix host *) |
IMPORT SYSTEM, _unix; |
(* provide some Oberon friendly POSIX without need for SYSTEM *) |
CONST RTLD_LAZY* = 1; |
O_RDONLY* = 0; |
O_NEWFILE* = 0C2H; (* O_RDWR | O_CREAT | O_EXCL *) |
(* O_RDONLY=0, O_WRONLY=1, O_RDWR=2, O_CREAT=0x40, O_EXCL=0x80, O_TRUNC=0x200 *) |
FD_SETSIZE* = 1024; (* fd for select() must be smaller than FD_SETSIZE *) |
BIT_DEPTH* = _unix.BIT_DEPTH; |
LEN_FD_SET = FD_SETSIZE DIV BIT_DEPTH; |
TYPE |
timespec* = RECORD |
tv_sec*, tv_usec* :INTEGER |
END; |
fd_set* = POINTER TO RECORD (* for select() *) |
bits* :ARRAY LEN_FD_SET OF SET (* 1024 bits *) |
END; |
VAR |
dlopen* :PROCEDURE [linux] (name, flags :INTEGER) :INTEGER; |
dlsym* :PROCEDURE [linux] (p, name :INTEGER) :INTEGER; |
dlclose* :PROCEDURE [linux] (p :INTEGER) :INTEGER; |
close* :PROCEDURE [linux] (fd :INTEGER) :INTEGER; |
exit* :PROCEDURE [linux] (n :INTEGER); |
malloc* :PROCEDURE [linux] (sz :INTEGER) :INTEGER; |
PROCEDURE open* (path :ARRAY OF CHAR; flag, perm :INTEGER) :INTEGER; |
BEGIN RETURN _unix._open (SYSTEM.ADR(path[0]), flag, perm) END open; |
PROCEDURE read* (fd :INTEGER; VAR buf :ARRAY OF BYTE; len :INTEGER) :INTEGER; |
BEGIN RETURN _unix._read (fd, SYSTEM.ADR(buf[0]), len) END read; |
PROCEDURE readByte* (fd :INTEGER; VAR n :BYTE) :INTEGER; |
BEGIN RETURN _unix._read (fd, SYSTEM.ADR(n), 1) END readByte; |
PROCEDURE write* (fd :INTEGER; buf :ARRAY OF BYTE; len :INTEGER) :INTEGER; |
BEGIN RETURN _unix._write (fd, SYSTEM.ADR(buf[0]), len) END write; |
PROCEDURE writeByte* (fd :INTEGER; n :BYTE) :INTEGER; |
BEGIN RETURN _unix._write (fd, SYSTEM.ADR(n), 1) END writeByte; |
PROCEDURE FD_ZERO* (VAR selectSet :fd_set); |
VAR i :INTEGER; |
BEGIN FOR i := 0 TO LEN_FD_SET-1 DO selectSet.bits[i] := {} END END FD_ZERO; |
PROCEDURE FD_SET* (fd :INTEGER; VAR selectSet :fd_set); (* set fd bit in a select() fd_set *) |
BEGIN INCL(selectSet.bits[fd DIV BIT_DEPTH], fd MOD BIT_DEPTH) |
END FD_SET; |
PROCEDURE select* (cnt :INTEGER; readfds, writefds, exceptfds :fd_set; timeout :timespec) :INTEGER; |
VAR n1, n2, n3 :INTEGER; |
BEGIN |
n1 := 0; IF readfds # NIL THEN n1 := SYSTEM.ADR (readfds.bits[0]) END; |
n2 := 0; IF writefds # NIL THEN n2 := SYSTEM.ADR (writefds.bits[0]) END; |
n3 := 0; IF exceptfds # NIL THEN n3 := SYSTEM.ADR (exceptfds.bits[0]) END; |
RETURN _unix._select (cnt, n1, n2, n3, SYSTEM.ADR(timeout)) |
END select; |
PROCEDURE finish*; |
BEGIN _unix.finish; END finish; |
BEGIN |
dlopen := _unix._dlopen; |
dlsym := _unix._dlsym; |
dlclose := _unix._dlclose; |
close := _unix._close; |
exit := _unix._exit; |
malloc := _unix._malloc; |
END unix. |
/programs/develop/oberon07/Samples/Linux/X11/filler/_unix.ob07 |
---|
0,0 → 1,74 |
MODULE _unix; (* connect to unix host *) |
IMPORT SYSTEM, API; |
(* how to find C declarations: |
- gcc -E preprocess only (to stdout) (preprocessor expand) |
- grep -r name /usr/include/* |
- ldd progfile |
- objdump -T progfile (-t) (-x) |
*) |
CONST RTLD_LAZY = 1; |
BIT_DEPTH* = API.BIT_DEPTH; |
VAR sym, libc, libdl :INTEGER; |
_dlopen* :PROCEDURE [linux] (name, flags :INTEGER) :INTEGER; |
_dlsym* :PROCEDURE [linux] (p, name :INTEGER) :INTEGER; |
_dlclose* :PROCEDURE [linux] (p :INTEGER) :INTEGER; |
_open* :PROCEDURE [linux] (name, flags, mode :INTEGER) :INTEGER; |
_close* :PROCEDURE [linux] (fd :INTEGER) :INTEGER; |
_read* :PROCEDURE [linux] (fd, buf, sz :INTEGER): INTEGER; |
_write* :PROCEDURE [linux] (fd, buf, sz :INTEGER) :INTEGER; |
_exit* :PROCEDURE [linux] (n :INTEGER); |
_malloc* :PROCEDURE [linux] (sz :INTEGER) :INTEGER; |
_select* :PROCEDURE [linux] (cnt, readfds, writefds, exceptfds, timeout :INTEGER) :INTEGER; |
(* error message to stderr *) |
PROCEDURE writeChar (c :CHAR); |
VAR ri :INTEGER; |
BEGIN ri := _write (2, SYSTEM.ADR(c), 1); ASSERT (ri = 1) END writeChar; |
PROCEDURE writeString (s :ARRAY OF CHAR); |
VAR i :INTEGER; |
BEGIN i := 0; WHILE s[i] # 0X DO writeChar (s[i]); INC(i) END; END writeString; |
PROCEDURE nl; |
BEGIN writeChar (0AX) END nl; |
PROCEDURE getSymAdr (lib :INTEGER; name :ARRAY OF CHAR; adr :INTEGER); |
BEGIN |
sym := _dlsym (lib, SYSTEM.ADR(name[0])); |
IF sym = 0 THEN writeString ("error: dlsym: "); writeString (name); nl END; |
ASSERT (sym # 0); |
SYSTEM.PUT (adr, sym) |
END getSymAdr; |
PROCEDURE finish*; |
VAR ri :INTEGER; |
BEGIN |
IF libc # 0 THEN ri := _dlclose (libc); libc := 0 END; |
IF libdl # 0 THEN ri := _dlclose (libdl); libdl := 0 END; |
END finish; |
BEGIN |
_dlopen := API.dlopen; |
_dlsym := API.dlsym; |
libc := _dlopen (SYSTEM.SADR("libc.so.6"), RTLD_LAZY); ASSERT (libc # 0); |
(* getSymAdr is not used for write() to get writeString() error message going *); |
sym := _dlsym (libc, SYSTEM.SADR("write")); ASSERT (sym # 0); SYSTEM.PUT (SYSTEM.ADR(_write), sym); |
libdl := _dlopen (SYSTEM.SADR("libdl.so.2"), RTLD_LAZY); ASSERT (libdl # 0); |
getSymAdr (libdl, "dlclose", SYSTEM.ADR(_dlclose)); |
getSymAdr (libc, "open", SYSTEM.ADR(_open)); |
getSymAdr (libc, "close", SYSTEM.ADR(_close)); |
getSymAdr (libc, "read", SYSTEM.ADR(_read)); |
getSymAdr (libc, "exit", SYSTEM.ADR(_exit)); |
getSymAdr (libc, "malloc", SYSTEM.ADR(_malloc)); |
getSymAdr (libc, "select", SYSTEM.ADR(_select)); |
END _unix. |
/programs/develop/oberon07/Samples/Linux/X11/filler/filler.ob07 |
---|
0,0 → 1,221 |
MODULE filler; (* filler game, color more fields than the opponent *) |
IMPORT SYSTEM, out, unix, gr; |
CONST |
Side = 14; (* nr of pixels of a field side *) |
width = 62; height = 48; (* board size *) |
nrFields = width * height; |
BackGroundColor = 0B0B050H; |
VAR fdRandom :INTEGER; (* /dev/urandom *) |
base, stride, screenBufSize :INTEGER; |
palette :ARRAY 6 OF INTEGER; |
field :ARRAY nrFields OF INTEGER; (* color 0..5 *) |
visit :ARRAY nrFields OF INTEGER; (* 0 unvisited, 1 neighbour to do, 2 done *) |
Acount, Acolor, Bcount, Bcolor :INTEGER; (* player conquered fields and current color *) |
rndSeed, rndIndex :INTEGER; |
PROCEDURE check (b :BOOLEAN; n :INTEGER); |
BEGIN |
IF ~b THEN |
out.formatInt ("internal check failed: filler.mod: %", n); out.nl; |
out.exit(1) |
END |
END check; |
PROCEDURE random6 () :INTEGER; (* return random 0..5 *) |
VAR n :INTEGER; |
b :BYTE; |
BEGIN |
IF rndIndex = 3 THEN |
(* 6 ^ 3 = 216 so 3 random6 nrs fit in one random byte, don't waste entropy *) |
n := unix.readByte (fdRandom, b); ASSERT (n = 1); |
rndSeed := b; rndIndex := 0; |
END; |
n := rndSeed MOD 6; rndSeed := rndSeed DIV 6; INC (rndIndex) |
RETURN n |
END random6; |
PROCEDURE drawRect (x, y, color :INTEGER); |
VAR p, i, j :INTEGER; |
BEGIN |
p := (y*stride + x*4)*Side; |
check (p + (Side-1)*stride + (Side-1)*4 <= screenBufSize, 20); |
p := base + p; |
FOR j := 0 TO Side-1 DO |
FOR i := 0 TO Side-1 DO SYSTEM.PUT32 (p, color); INC(p, 4) END; |
p := p + stride - Side*4; |
END; |
END drawRect; |
PROCEDURE clearVisit; |
VAR i :INTEGER; |
BEGIN FOR i := 0 TO nrFields-1 DO visit[i] := 0 END; END clearVisit; |
PROCEDURE doNeighbour (i, old, new, v :INTEGER; VAR changed :BOOLEAN); |
(* helper routine for connect() *) |
BEGIN |
IF visit[i] = 0 THEN |
IF (v = 1) & (field[i] = old) THEN visit[i] := 1; changed := TRUE END; |
IF field[i] = new THEN visit[i] := 2; changed := TRUE END |
END |
END doNeighbour; |
(* |
all visit := 0; count := 0; visit[corner] := 1 |
repeat |
changed := false; |
foreach: |
if (visit = 1) or (visit = 2) then |
curVisit = visit |
color := new; visit := 3; count++ |
foreach neighbour: |
if visit = 0 then |
if curVisit = 1 then |
if color = old then visit := 1; changed := true |
if color = new then visit := 2; changed := true |
if curVisit = 2 then |
if color = new then visit := 2; changed := true |
until no changes |
*) |
PROCEDURE connect (old, new :INTEGER) :INTEGER; |
VAR count, i, x, y, v :INTEGER; |
changed :BOOLEAN; |
BEGIN |
out.formatInt2 ("connect: old new % % ", old+1, new+1); |
count := 0; |
REPEAT |
changed := FALSE; |
FOR i := 0 TO nrFields-1 DO |
v := visit[i]; |
IF (v=1) OR (v=2) THEN |
field[i] := new; visit[i] := 3; INC(count); |
x := i MOD width; y := i DIV width; |
IF x > 0 THEN doNeighbour (i-1, old, new, v, changed) END; |
IF x < width-1 THEN doNeighbour (i+1, old, new, v, changed) END; |
IF y > 0 THEN doNeighbour (i-width, old, new, v, changed) END; |
IF y < height-1 THEN doNeighbour (i+width, old, new, v, changed) END; |
END |
END |
UNTIL ~changed |
RETURN count |
END connect; |
PROCEDURE doMaxGainNeighbour (i, old, new, v :INTEGER; VAR changed :BOOLEAN); |
(* helper routine for maxGain() *) |
BEGIN |
IF visit[i] = 0 THEN |
IF v = 1 THEN |
IF field[i] = old THEN visit[i] := 1 ELSE visit[i] := 2 END; |
changed := TRUE |
ELSE |
IF field[i] = new THEN visit[i] := 2; changed := TRUE END |
END |
END |
END doMaxGainNeighbour; |
(* v=1 & field=old -> visit := 1 |
v=1 & field # old -> visit := 2 |
v=2 & field = new -> visit := 2 |
*) |
PROCEDURE maxGain (old :INTEGER) :INTEGER; |
(* return the color which will conquer the most fields *) |
VAR |
i, x, y, new, v :INTEGER; |
max :ARRAY 6 OF INTEGER; |
changed :BOOLEAN; |
BEGIN |
FOR i := 0 TO 5 DO max[i] := 0 END; |
REPEAT |
changed := FALSE; |
FOR i := 0 TO nrFields-1 DO |
v := visit[i]; |
IF (v=1) OR (v=2) THEN |
visit[i] := 3; new := field[i]; INC (max[new]); |
x := i MOD width; y := i DIV width; |
IF x > 0 THEN doMaxGainNeighbour (i-1, old, new, v, changed) END; |
IF x < width-1 THEN doMaxGainNeighbour (i+1, old, new, v, changed) END; |
IF y > 0 THEN doMaxGainNeighbour (i-width, old, new, v, changed) END; |
IF y < height-1 THEN doMaxGainNeighbour (i+width, old, new, v, changed) END; |
END |
END |
UNTIL ~changed; |
x := -1; y := -1; max[Acolor] := -1; max[Bcolor] := -1; |
out.str ("maxGain"); out.nl; |
FOR i := 0 TO 5 DO out.formatInt2 (" % %", i+1, max[i]); out.nl END; |
FOR i := 0 TO 5 DO IF (max[i] > y) & (i # old) THEN x := i; y := max[i] END END |
RETURN x |
END maxGain; |
PROCEDURE drawAll; |
VAR x, y :INTEGER; |
BEGIN |
gr.screenBegin; |
gr.clear (BackGroundColor); |
FOR y := 0 TO 5 DO drawRect (0, 6 + y DIV 3 + 2*y, palette[y]) END; |
FOR y := 0 TO 47 DO |
FOR x := 0 TO 61 DO drawRect (x+2, y, palette[ field[y*width + x] ]) END |
END; |
gr.screenEnd; |
END drawAll; |
PROCEDURE run*; |
VAR stop :BOOLEAN; |
ev :gr.EventPars; |
x, y, i, old :INTEGER; |
ch :CHAR; |
BEGIN |
FOR i := 0 TO nrFields-1 DO field[i] := random6() END; |
Acolor := field[47*width]; field[47*width+1] := Acolor; field[46*width] := Acolor; field[46*width+1] := Acolor; |
Bcolor := field[width-1]; field[width-2] := Bcolor; field[2*width-2] := Bcolor; field[2*width-1] := Bcolor; |
base := gr.base; stride := gr.stride; |
gr.createWindow (1000, 700); |
screenBufSize := gr.winHeight * stride; |
stop := FALSE; |
drawAll; |
REPEAT |
gr.nextEvent (0, ev); |
IF ev[0] = gr.EventKeyPressed THEN |
(* o.formatInt("key pressed %",ev[2]);o.nl; *) |
(* ev[2]: q=24, ESC=9, CR=36 *) |
ch := CHR (ev[4]); |
IF ev[2] = 9 THEN stop := TRUE END; (* ESC *) |
(* IF ch = "q" THEN stop := TRUE END; *) |
IF (ch >= "1") & (ch <= "6") THEN |
i := ev[4] - ORD("1"); |
IF (i # Acolor) & (i # Bcolor) THEN |
(* player A *) |
old := Acolor; Acolor := i; |
out.formatInt ("play color %", Acolor+1); out.nl; |
clearVisit; visit[47*width] := 1; |
Acount := connect (old, Acolor) |
;out.formatInt ("count A = %", Acount); out.nl; out.nl; |
(* player B *) |
clearVisit; visit[width-1] := 1; old := field[width-1]; |
Bcolor := maxGain (old); |
clearVisit; visit[width-1] := 1; |
Bcount := connect (old, Bcolor); |
out.formatInt ("count B = %", Bcount); out.nl; out.nl; |
drawAll; |
END |
END; |
ELSIF ev[0] = gr.EventButtonPressed THEN |
x := ev[2] DIV Side; y := ev[3] DIV Side; |
END; |
UNTIL stop; |
gr.finish; |
unix.finish; |
END run; |
BEGIN |
fdRandom := unix.open ("/dev/urandom", unix.O_RDONLY, 0); ASSERT (fdRandom # -1); |
rndIndex := 3; |
(* a partial copy of the lexaloffle pico-8 16-color palette *) |
palette[0] := 0FF004DH; (* red *) |
palette[1] := 0FFA300H; (* orange *) |
palette[2] := 07E2553H; (* dark purple *) |
palette[3] := 0008751H; (* dark green *) |
palette[4] := 029ADFFH; (* blue *) |
palette[5] := 0FF77A8H; (* pink *) |
run; |
END filler. |
/programs/develop/oberon07/Samples/Linux/X11/filler/filler.txt |
---|
0,0 → 1,15 |
|
Filler game |
Player and computer each try to conquer the most fields. |
Player starts at left bottom and computer at right top. |
At each turn, a new color is chosen and area extended. |
Press 1 .. 6 to choose color. At the left side of the board the top |
color has nr 1 and the bottom color nr 6. The current colors of player |
and opponent can not be chosen. The current area receives the new color |
and is extended with all bordering areas of the chosen color. |
Have fun! |
/programs/develop/oberon07/Samples/Linux/X11/filler/gr.ob07 |
---|
0,0 → 1,292 |
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. |
/programs/develop/oberon07/Samples/Linux/X11/filler/out.ob07 |
---|
0,0 → 1,142 |
MODULE out; (* formatted output to stdout *) |
(* Wim Niemann, Jan Tuitman 06-OCT-2016 *) |
IMPORT SYSTEM, _unix; |
(* example: IMPORT o:=out; |
o.str("Hello, World!");o.nl; |
o.formatInt("n = %", 3);o.nl; |
*) |
(* |
The output functions buffer the characters in buf. This buffer is flushed when out.nl is |
called and also when the buffer is full. |
Calling flush once per line is far more efficient then one system call per |
character, but this is noticable only at very long outputs. |
*) |
CONST MAX = 63; (* last position in buf *) |
VAR len :INTEGER; (* string length in buf *) |
buf :ARRAY MAX+1 OF BYTE; |
PROCEDURE exit* (n :INTEGER); |
(* prevent IMPORT unix for many programs *) |
BEGIN _unix._exit(n) END exit; |
PROCEDURE writeChars; |
(* write buf to the output function and set to empty string *) |
VAR ri :INTEGER; |
BEGIN |
IF len > 0 THEN |
(* buf[len] := 0X; *) |
ri := _unix._write (1, SYSTEM.ADR(buf), len); ASSERT (ri = len); (* stdout *) |
len := 0 |
END |
END writeChars; |
PROCEDURE nl*; (* append a newline to buf and flush *) |
BEGIN |
IF len = MAX THEN writeChars END; |
buf[len] := 0AH; INC(len); |
(* unix: 0AX; Oberon: 0DX; |
Windows: IF len >= MAX-1 THEN 0DX 0AX; *) |
writeChars; |
END nl; |
PROCEDURE char* (c :CHAR); |
(* append char to the end of buf *) |
BEGIN |
IF len = MAX THEN writeChars END; |
buf[len] := ORD(c); INC(len) |
END char; |
PROCEDURE str* (t :ARRAY OF CHAR); |
(* append t to buf *) |
VAR j :INTEGER; |
BEGIN |
j := 0; WHILE t[j] # 0X DO char(t[j]); INC(j) END |
END str; |
PROCEDURE int* (n :INTEGER); |
(* append integer; append n to d, return TRUE on overflow of d *) |
VAR j :INTEGER; |
sign :BOOLEAN; |
dig :ARRAY 11 OF CHAR; (* assume 32 bit INTEGER *) |
BEGIN |
sign := FALSE; IF n < 0 THEN sign := TRUE; n := -n END; |
IF n < 0 THEN |
str ("-2147483648"); |
ELSE |
j := 0; |
REPEAT dig[j] := CHR (n MOD 10 + 30H); n := n DIV 10; INC(j) UNTIL n = 0; |
IF sign THEN char ("-") END; |
REPEAT DEC(j); char(dig[j]) UNTIL j = 0; |
END |
END int; |
PROCEDURE formatInt* (t :ARRAY OF CHAR; n :INTEGER); |
(* append formatted string t. Replace the first % by n *) |
VAR j :INTEGER; |
BEGIN |
j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END; |
IF t[j] = "%" THEN |
int(n); INC(j); |
WHILE t[j] # 0X DO char(t[j]); INC(j) END |
END |
END formatInt; |
PROCEDURE formatInt2* (t:ARRAY OF CHAR; n1, n2 :INTEGER); |
(* append formatted string t. Replace the first two % by n1 and n2 *) |
VAR j :INTEGER; |
BEGIN |
j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END; |
IF t[j] = "%" THEN |
int(n1); INC(j); |
WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END; |
IF t[j] = "%" THEN |
int(n2); INC(j); |
WHILE t[j] # 0X DO char(t[j]); INC(j) END |
END |
END |
END formatInt2; |
PROCEDURE formatStr* (t, u :ARRAY OF CHAR); |
(* append formatted string. Replace the first % in t by u *) |
VAR j, k :INTEGER; |
BEGIN |
j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END; |
IF t[j] = "%" THEN |
k := 0; WHILE u[k] # 0X DO char(u[k]); INC(k) END; |
INC(j); WHILE t[j] # 0X DO char(t[j]); INC(j) END |
END |
END formatStr; |
PROCEDURE hex* (n, width :INTEGER); |
(* print width positions of n as hex string. If necessary, prefix with leading zeroes *) |
(* note: if n needs more positions than width, the first hex digits are not printed *) |
VAR j :INTEGER; |
dig :ARRAY 9 OF CHAR; |
BEGIN |
ASSERT(width > 0); |
ASSERT (width <= 8); |
dig[width] := 0X; |
REPEAT |
j := n MOD 16; n := n DIV 16; |
IF j < 10 THEN j := ORD("0") + j ELSE j := ORD("A") + j - 10 END; |
DEC(width); dig[width] := CHR(j) |
UNTIL width = 0; |
str (dig); |
END hex; |
PROCEDURE flush*; |
(* this routine comes at the end. It won't hardly ever be called |
because nl also flushes. It is present only in case you |
want to write a flushed string which does not end with nl. *) |
BEGIN writeChars END flush; |
(* note: global variable 'len' must be 0 on init. Within the core, bodies of imported modules |
are not executed, so rely on zero initialisation by Modules.Load *) |
END out. |
/programs/develop/oberon07/Samples/Linux/X11/filler/unix.ob07 |
---|
0,0 → 1,74 |
MODULE unix; (* connect to unix host *) |
IMPORT SYSTEM, _unix; |
(* provide some Oberon friendly POSIX without need for SYSTEM *) |
CONST RTLD_LAZY* = 1; |
O_RDONLY* = 0; |
O_NEWFILE* = 0C2H; (* O_RDWR | O_CREAT | O_EXCL *) |
(* O_RDONLY=0, O_WRONLY=1, O_RDWR=2, O_CREAT=0x40, O_EXCL=0x80, O_TRUNC=0x200 *) |
FD_SETSIZE* = 1024; (* fd for select() must be smaller than FD_SETSIZE *) |
BIT_DEPTH* = _unix.BIT_DEPTH; |
LEN_FD_SET = FD_SETSIZE DIV BIT_DEPTH; |
TYPE |
timespec* = RECORD |
tv_sec*, tv_usec* :INTEGER |
END; |
fd_set* = POINTER TO RECORD (* for select() *) |
bits* :ARRAY LEN_FD_SET OF SET (* 1024 bits *) |
END; |
VAR |
dlopen* :PROCEDURE [linux] (name, flags :INTEGER) :INTEGER; |
dlsym* :PROCEDURE [linux] (p, name :INTEGER) :INTEGER; |
dlclose* :PROCEDURE [linux] (p :INTEGER) :INTEGER; |
close* :PROCEDURE [linux] (fd :INTEGER) :INTEGER; |
exit* :PROCEDURE [linux] (n :INTEGER); |
malloc* :PROCEDURE [linux] (sz :INTEGER) :INTEGER; |
PROCEDURE open* (path :ARRAY OF CHAR; flag, perm :INTEGER) :INTEGER; |
BEGIN RETURN _unix._open (SYSTEM.ADR(path[0]), flag, perm) END open; |
PROCEDURE read* (fd :INTEGER; VAR buf :ARRAY OF BYTE; len :INTEGER) :INTEGER; |
BEGIN RETURN _unix._read (fd, SYSTEM.ADR(buf[0]), len) END read; |
PROCEDURE readByte* (fd :INTEGER; VAR n :BYTE) :INTEGER; |
BEGIN RETURN _unix._read (fd, SYSTEM.ADR(n), 1) END readByte; |
PROCEDURE write* (fd :INTEGER; buf :ARRAY OF BYTE; len :INTEGER) :INTEGER; |
BEGIN RETURN _unix._write (fd, SYSTEM.ADR(buf[0]), len) END write; |
PROCEDURE writeByte* (fd :INTEGER; n :BYTE) :INTEGER; |
BEGIN RETURN _unix._write (fd, SYSTEM.ADR(n), 1) END writeByte; |
PROCEDURE FD_ZERO* (VAR selectSet :fd_set); |
VAR i :INTEGER; |
BEGIN FOR i := 0 TO LEN_FD_SET-1 DO selectSet.bits[i] := {} END END FD_ZERO; |
PROCEDURE FD_SET* (fd :INTEGER; VAR selectSet :fd_set); (* set fd bit in a select() fd_set *) |
BEGIN INCL(selectSet.bits[fd DIV BIT_DEPTH], fd MOD BIT_DEPTH) |
END FD_SET; |
PROCEDURE select* (cnt :INTEGER; readfds, writefds, exceptfds :fd_set; timeout :timespec) :INTEGER; |
VAR n1, n2, n3 :INTEGER; |
BEGIN |
n1 := 0; IF readfds # NIL THEN n1 := SYSTEM.ADR (readfds.bits[0]) END; |
n2 := 0; IF writefds # NIL THEN n2 := SYSTEM.ADR (writefds.bits[0]) END; |
n3 := 0; IF exceptfds # NIL THEN n3 := SYSTEM.ADR (exceptfds.bits[0]) END; |
RETURN _unix._select (cnt, n1, n2, n3, SYSTEM.ADR(timeout)) |
END select; |
PROCEDURE finish*; |
BEGIN _unix.finish; END finish; |
BEGIN |
dlopen := _unix._dlopen; |
dlsym := _unix._dlsym; |
dlclose := _unix._dlclose; |
close := _unix._close; |
exit := _unix._exit; |
malloc := _unix._malloc; |
END unix. |