ruberon/samples/linux/x11/common/out.ob07

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.