Gold Fish 3/goldfish_volume_3.bin/files/misc/math/fastplot/source/stringutils.mod

Modula Implementation | 1995-03-27 | 4.1 KB | 227 lines

(*********************************************************************)
(*                                                                   *)
(* Module StringUtils Copyright © 1994 by Computer Inspirations      *)
(*                                                                   *)
(*********************************************************************)

IMPLEMENTATION MODULE StringUtils;

FROM SYSTEM IMPORT BYTE;

CONST
  ZERO  = 0.0;
  ONE   = 1.0;
  TEN   = 10.0;
  TENTH = 0.1;


PROCEDURE PowerOfTen(power:INTEGER): REAL;    (*10^power*)
VAR
  result : REAL;
BEGIN
  result := 1.0;

  IF power > 0 THEN
    REPEAT
      result := result * TEN;
      DEC(power);
    UNTIL power=0;
  ELSIF power < 0 THEN
    REPEAT
      result := result / TEN;
      INC(power);
    UNTIL power=0;
  END;

  RETURN result;
END PowerOfTen;


PROCEDURE GetExp(num:REAL): INTEGER;
VAR
  i : INTEGER;
  b : RECORD
        CASE :CARDINAL OF
          |0: r           : REAL;
          |1: b0,b1,b2,b3 : BYTE;
        END;
      END;
BEGIN
  b.r:=num;
  i := INTEGER(b.b3) MOD 128;

  IF i>3FH THEN
    i:= (LONGCARD(i)-3FH)*77 DIV 256;
  ELSE
    i:= -INTEGER((3FH-LONGCARD(i))*77 DIV 256);
  END;
  RETURN i;
END GetExp;


PROCEDURE ConvRealToStr(VAR str:ARRAY OF CHAR;
                        num:REAL;
                        minchars:CARDINAL;
                        fracchars:INTEGER;
                        pad:CHAR): BOOLEAN;
CONST
  RAcc = 6; (* digits of accuracy in REAL we can count on *)
VAR
  D,s,exp : INTEGER;
  buffer  : ARRAY [0..80] OF CHAR;
  pos,i,j : INTEGER;
  useExp  : BOOLEAN;

  PROCEDURE PutCh(c:CHAR);
  BEGIN
    buffer[pos]:=c;
    INC(pos);
  END PutCh;

  PROCEDURE PutNumDig(c:CARDINAL);
  BEGIN
    buffer[pos]:=CHR(c+ORD("0"));
    INC(pos);
  END PutNumDig;

  PROCEDURE PutExp(exp:INTEGER);
  BEGIN
    PutCh('E');
    IF exp<0 THEN
      PutCh('-');
      exp:=-i;
    END;

    IF exp>10 THEN
      PutNumDig((exp MOD 100) DIV 10);
    END;

    PutNumDig(exp MOD 10);
  END PutExp;

BEGIN
  pos:=0;

  D := ABS(fracchars);
  useExp:= (fracchars < 0);

  IF num < ZERO THEN
    PutCh("-");
    num := -num;
  END;

  IF num=ZERO THEN
    exp := 0;
    num := ZERO;
  ELSE
    (* round to D digits to the right of the decimal *)
    IF D > RAcc THEN
      D := RAcc;
    END;
    num:=num+PowerOfTen(-D)*0.5;

    (* normalize number *)
    exp := GetExp(num);
    num := num / PowerOfTen(exp);

    (* check if rounding changed first digit of mantissa *)
    (* i.e., 9.99999 changed to 10.00000 *)
    IF num >= TEN THEN
      num := num / TEN;
      INC(exp);
    END;

    (* special case when ABS(num) < 1.0 *)
    IF num < 1.0 THEN
      num := num * TEN;
      DEC(exp);
    END;

    (* check if this number can be represented
       in ordinary form *)
    IF ABS(exp) > RAcc THEN
      useExp := TRUE;
    END;
  END;

  IF useExp THEN
    PutNumDig(TRUNC(num));
    PutCh(".");

    j:=D;
    WHILE j>0 DO
      num := (num - FLOAT(TRUNC(num))) * TEN;
      PutNumDig(TRUNC(num));
      DEC(j);
    END;

    PutExp(exp);

  ELSE
    s := exp;  (* begin with digits to left of decimal *)
    IF exp < 0 THEN
      s := 0;  (* begin at zero to left of decimal *)
    END;

    i := 0;
    FOR j := s TO (-D) BY -1 DO
      IF (i > RAcc) OR (exp < 0) THEN
      (* use dummy zeros to pad right *)
        PutCh("0");
      ELSE
        PutNumDig(TRUNC(num));
        num := (num - FLOAT(TRUNC(num))) * TEN;
      END;
      INC(i);
      INC(exp);
      IF j = 0 THEN
        PutCh(".");
      END;
    END;
  END;

  PutCh(0C);

  IF (minchars>HIGH(str)) OR (CARDINAL(pos)>HIGH(str)) THEN
    RETURN FALSE;
  END;

  i:=0;                    (* put padding *)
  WHILE i+pos<=INTEGER(minchars) DO
    str[i]:=pad;
    INC(i);
  END;

  j:=-1;
  (* copy data into destination *)
  REPEAT
    INC(j);
    str[i]:=buffer[j];
    INC(i);
  UNTIL buffer[j]=0C;

  IF (j > 0) & (str[j-1] = '.') THEN
    (* remove trailing '.' *)
    str[j-1] := 0C;
  END;

  RETURN TRUE;
END ConvRealToStr;


PROCEDURE LengthStr(s : ARRAY OF CHAR) : CARDINAL;
VAR
  i : CARDINAL;
BEGIN
  i := 0;
  WHILE (s[i] # 0C) & (i # HIGH(s)) DO
    INC(i);
  END;
  IF s[i] # 0C THEN
    INC(i);
  END;
  RETURN i;
END LengthStr;


END StringUtils.