Subversion Repositories Kolibri OS

(*

    Copyright 2016 Anton Krotov

    This program is free software: you can redistribute it and/or modify

    it under the terms of the GNU Lesser General Public License as published by

    the Free Software Foundation, either version 3 of the License, or

    (at your option) any later version.

    This program is distributed in the hope that it will be useful,

    but WITHOUT ANY WARRANTY; without even the implied warranty of

    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    GNU Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public License

    along with this program.  If not, see .

*)

MODULE Out;

IMPORT ConsoleLib, sys := SYSTEM;

CONST

  d = 1.0D0 - 5.0D-12;

VAR

  Realp: PROCEDURE (x: LONGREAL; width: INTEGER);

PROCEDURE Char*(c: CHAR);

BEGIN

  ConsoleLib.write_string(sys.ADR(c), 1)

END Char;

PROCEDURE String*(s: ARRAY OF CHAR);

BEGIN

  ConsoleLib.write_string(sys.ADR(s[0]), LENGTH(s))

END String;

PROCEDURE WriteInt(x, n: INTEGER);

VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN;

BEGIN

  i := 0;

  IF n < 1 THEN

    n := 1

  END;

  IF x < 0 THEN

    x := -x;

    DEC(n);

    neg := TRUE

  END;

  REPEAT

    a[i] := CHR(x MOD 10 + ORD("0"));

    x := x DIV 10;

    INC(i)

  UNTIL x = 0;

  WHILE n > i DO

    Char(" ");

    DEC(n)

  END;

  IF neg THEN

    Char("-")

  END;

  REPEAT

    DEC(i);

    Char(a[i])

  UNTIL i = 0

END WriteInt;

PROCEDURE IsNan(AValue: LONGREAL): BOOLEAN;

VAR h, l: SET;

BEGIN

  sys.GET(sys.ADR(AValue), l);

  sys.GET(sys.ADR(AValue) + 4, h)

  RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))

END IsNan;

PROCEDURE IsInf(x: LONGREAL): BOOLEAN;

  RETURN ABS(x) = sys.INF(LONGREAL)

END IsInf;

PROCEDURE Int*(x, width: INTEGER);

VAR i: INTEGER;

BEGIN

  IF x # 80000000H THEN

    WriteInt(x, width)

  ELSE

    FOR i := 12 TO width DO

      Char(20X)

    END;

    String("-2147483648")

  END

END Int;

PROCEDURE OutInf(x: LONGREAL; width: INTEGER);

VAR s: ARRAY 4 OF CHAR; i: INTEGER;

BEGIN

  IF IsNan(x) THEN

    s := "Nan";

    INC(width)

  ELSIF IsInf(x) & (x > 0.0D0) THEN

    s := "+Inf"

  ELSIF IsInf(x) & (x < 0.0D0) THEN

    s := "-Inf"

  END;

  FOR i := 1 TO width - 4 DO

    Char(" ")

  END;

  String(s)

END OutInf;

PROCEDURE Ln*;

BEGIN

  Char(0DX);

  Char(0AX)

END Ln;

PROCEDURE _FixReal(x: LONGREAL; width, p: INTEGER);

VAR e, len, i: INTEGER; y: LONGREAL; minus: BOOLEAN;

BEGIN

  IF IsNan(x) OR IsInf(x) THEN

    OutInf(x, width)

  ELSIF p < 0 THEN

    Realp(x, width)

  ELSE

    len := 0;

    minus := FALSE;

    IF x < 0.0D0 THEN

      minus := TRUE;

      INC(len);

      x := ABS(x)

    END;

    e := 0;

    WHILE x >= 10.0D0 DO

      x := x / 10.0D0;

      INC(e)

    END;

    IF e >= 0 THEN

      len := len + e + p + 1;

      IF x > 9.0D0 + d THEN

	INC(len)

      END;

      IF p > 0 THEN

	INC(len)

      END

    ELSE

      len := len + p + 2

    END;

    FOR i := 1 TO width - len DO

      Char(" ")

    END;

    IF minus THEN

      Char("-")

    END;

    y := x;

    WHILE (y < 1.0D0) & (y # 0.0D0) DO

      y := y * 10.0D0;

      DEC(e)

    END;

    IF e < 0 THEN

      IF x - LONG(FLT(FLOOR(x))) > d THEN

	Char("1");

	x := 0.0D0

      ELSE

	Char("0");

	x := x * 10.0D0

      END

    ELSE

      WHILE e >= 0 DO

	IF x - LONG(FLT(FLOOR(x))) > d THEN

	  IF x > 9.0D0 THEN

	    String("10")

	  ELSE

	    Char(CHR(FLOOR(x) + ORD("0") + 1))

	  END;

	  x := 0.0D0

	ELSE

	  Char(CHR(FLOOR(x) + ORD("0")));

	  x := (x - LONG(FLT(FLOOR(x)))) * 10.0D0

	END;

	DEC(e)

      END

    END;

    IF p > 0 THEN

      Char(".")

    END;

    WHILE p > 0 DO

      IF x - LONG(FLT(FLOOR(x))) > d THEN

	Char(CHR(FLOOR(x) + ORD("0") + 1));

	x := 0.0D0

      ELSE

	Char(CHR(FLOOR(x) + ORD("0")));

	x := (x - LONG(FLT(FLOOR(x)))) * 10.0D0

      END;

      DEC(p)

    END

  END

END _FixReal;

PROCEDURE Real*(x: LONGREAL; width: INTEGER);

VAR e, n, i: INTEGER; minus: BOOLEAN;

BEGIN

  IF IsNan(x) OR IsInf(x) THEN

    OutInf(x, width)

  ELSE

    e := 0;

    n := 0;

    IF width > 23 THEN

      n := width - 23;

      width := 23

    ELSIF width < 9 THEN

      width := 9

    END;

    width := width - 5;

    IF x < 0.0D0 THEN

      x := -x;

      minus := TRUE

    ELSE

      minus := FALSE

    END;

    WHILE x >= 10.0D0 DO

      x := x / 10.0D0;

      INC(e)

    END;

    WHILE (x < 1.0D0) & (x # 0.0D0) DO

      x := x * 10.0D0;

      DEC(e)

    END;

    IF x > 9.0D0 + d THEN

      x := 1.0D0;

      INC(e)

    END;

    FOR i := 1 TO n DO

      Char(" ")

    END;

    IF minus THEN

      x := -x

    END;

    Realp := Real;

    _FixReal(x, width, width - 3);

    Char("E");

    IF e >= 0 THEN

      Char("+")

    ELSE

      Char("-");

      e := ABS(e)

    END;

    IF e < 100 THEN

      Char("0")

    END;

    IF e < 10 THEN

      Char("0")

    END;

    Int(e, 0)

  END

END Real;

PROCEDURE FixReal*(x: LONGREAL; width, p: INTEGER);

BEGIN

  Realp := Real;

  _FixReal(x, width, p)

END FixReal;

PROCEDURE Open*;

END Open;

END Out.