🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: comp.lang.modula2
Article #377

WriteFix(R, MFW, Digits)

#377
From: Tim North.
Date: Fri, 27 Oct 1989 02:27
72 lines
2945 bytes
Some time ago someone posted a routine called WriteFix to this group that
extended the standard WriteReal routine to include parameters for field width
AND number of digits to the right of the decimal place.

Unfortunately that routine worked by calling a string conversion library
that our system doesn't provide. Thus I felt the need to write a WriteFix
routine that only used the standard libraries.

What follows is a lightly tested hack that hopefully does the trick. If anyone
finds any bugs please give me a yell.

Enjoy:
Tim North, Curtin Universtity of Technology, Perth. Western Australia.
--------------------------------------------------------------------------
ACSnet:  TNORTHTJ@acad.cut.oz
ARPA  :  TNORTHTJ%acad.curtin.edu.au@uunet.uu.net
Bitnet:  TNORTHTJ%acad.curtin.edu.au%munnari.oz@cunyvm.bitnet
UUCP  :  {enea,mcvax,uunet,ubc-cs,ukc}!munnari!acad.curtin.edu.au!TNORTHTJ
UUCP  :  {enea,mcvax,uunet,ubc-cs,ukc}!munnari!mail.cut.oz.au!TNORTHTJ
--------------------------------------------------------------------------

MODULE FixTest;

FROM MathLib0 IMPORT ln;
FROM InOut    IMPORT Write, WriteLn, WriteCard, WriteString;

PROCEDURE WriteFix(R:REAL;           (* Real number to be printed *)
		   MFW : CARDINAL;   (* MINIMUM field width       *)
		   Digits : CARDINAL (* # digits to right of '.'  *)
		  );

(* Code by Tim North *)

VAR quot, q_size, i, d : CARDINAL;
    frac, temp : REAL;
    left, LeadingSpaces : INTEGER;

BEGIN
  quot := CARDINAL(ABS(TRUNC(R)));
  frac := ABS(R) - FLOAT(quot);
  left := INTEGER(MFW - Digits - 1); (* # chars to left of decimal point *)
  IF quot = 0 THEN
    (* prevent ln(0.0) error *)
    q_size := 1 (* # digits to left of '.' *)
  ELSE
    temp := ln(FLOAT(quot)) / ln(10.0) + 1.0;
    q_size := CARDINAL(TRUNC(temp)); 
  END;
  IF R < 0.0 THEN INC(q_size); END;  (* Allow for leading minus sign *)

  LeadingSpaces := left - INTEGER(q_size);
  IF LeadingSpaces > 0 THEN
    FOR i:=1 TO LeadingSpaces DO Write(' '); END;
  END;

  IF R < 0.0 THEN Write('-'); END;
  WriteCard(quot, 1);
  Write('.');

  FOR i:= 1 TO Digits DO
    d := CARDINAL(TRUNC(frac*10.0)); (* Get next digit *)
    frac := frac * 10.0 - FLOAT(d);
    WriteCard(d, 1);
  END;
END WriteFix;

BEGIN
  WriteString("-3.14, 10, 5 = "); WriteFix(-3.14, 10, 5); WriteLn;
  WriteString("-3.14,  1, 5 = "); WriteFix(-3.14,  1, 5); WriteLn;
  WriteString("-0.7,   8, 5 = "); WriteFix(-0.7,   8, 5); WriteLn;
  WriteString(" 0.7,   8, 5 = "); WriteFix( 0.7,   8, 5); WriteLn;
END FixTest.
Technical Details
Message-ID: <1192@acad.cut.oz>
Path: arc1-ca.pugleaf.net!utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!wuarchive!brutus.cs.uiuc.edu!ginosko!uunet!munnari.oz.au!uniwa!vax6!tnorthtj

Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!wuarchive!brutus.cs.uiuc.edu!ginosko!uunet!munnari.oz.au!uniwa!vax6!tnorthtj
From: TNORTHTJ@acad.cut.oz (Tim North.)
Newsgroups: comp.lang.modula2
Subject: WriteFix(R, MFW, Digits)
Message-ID: <1192@acad.cut.oz>
Date: 27 Oct 89 02:27:07 GMT
Organization: Curtin University of Technology
Lines: 71