Subversion Repositories Kolibri OS

Compare Revisions

Regard whitespace Rev 8096 → Rev 8097

/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.