gcc/m2/gm2-libs-pim/FloatingUtilities.mod

   1 (* FloatingUtilities.mod provides a Logitech compatible library.
   2
   3 Copyright (C) 2005-2023 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 3.1, as published by the Free Software Foundation.
  21
  22 You should have received a copy of the GNU General Public License and
  23 a copy of the GCC Runtime Library Exception along with this program;
  24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  25 <http://www.gnu.org/licenses/>.  *)
  26
  27 IMPLEMENTATION MODULE FloatingUtilities ;
  28
  29
  30 (*
  31    Frac - returns the fractional component of, r.
  32 *)
  33
  34 PROCEDURE Frac (r: REAL) : REAL ;
  35 BEGIN
  36    RETURN r-VAL(REAL, Int(r))
  37 END Frac ;
  38
  39
  40 (*
  41    Int - returns the integer part of r. It rounds the value towards zero.
  42 *)
  43
  44 PROCEDURE Int (r: REAL) : INTEGER ;
  45 BEGIN
  46    IF r>=0.0
  47    THEN
  48       RETURN VAL(INTEGER, r)
  49    ELSE
  50       RETURN -VAL(INTEGER, -r)
  51    END
  52 END Int ;
  53
  54
  55 (*
  56    Round - returns the number rounded to the nearest integer.
  57            It rounds away from zero.
  58 *)
  59
  60 PROCEDURE Round (r: REAL) : INTEGER ;
  61 BEGIN
  62    IF r>=0.0
  63    THEN
  64       RETURN Int(r+0.5)
  65    ELSE
  66       RETURN Int(r-0.5)
  67    END
  68 END Round ;
  69
  70
  71 (*
  72    Float - returns a REAL value corresponding to, i.
  73 *)
  74
  75 PROCEDURE Float (i: INTEGER) : REAL ;
  76 BEGIN
  77    RETURN VAL(REAL, i)
  78 END Float ;
  79
  80
  81 (*
  82    Trunc - round to the nearest integer not larger in absolute
  83            value.
  84 *)
  85
  86 PROCEDURE Trunc (r: REAL) : INTEGER ;
  87 BEGIN
  88    RETURN TRUNC(r)
  89 END Trunc ;
  90
  91
  92 (*
  93    Fracl - returns the fractional component of, r.
  94 *)
  95
  96 PROCEDURE Fracl (r: LONGREAL) : LONGREAL ;
  97 BEGIN
  98    RETURN r-VAL(LONGREAL, Intl(r))
  99 END Fracl ;
 100
 101
 102 (*
 103    Intl - returns the integer part of r. It rounds the value towards zero.
 104 *)
 105
 106 PROCEDURE Intl (r: LONGREAL) : LONGINT ;
 107 BEGIN
 108    IF r>=0.0
 109    THEN
 110       RETURN VAL(LONGINT, r)
 111    ELSE
 112       RETURN -VAL(LONGINT, -r)
 113    END
 114 END Intl ;
 115
 116
 117 (*
 118    Roundl - returns the number rounded to the nearest integer.
 119 *)
 120
 121 PROCEDURE Roundl (r: LONGREAL) : LONGINT ;
 122 BEGIN
 123    IF r>=0.0
 124    THEN
 125       RETURN Intl(r+0.5)
 126    ELSE
 127       RETURN Intl(r-0.5)
 128    END
 129 END Roundl ;
 130
 131
 132 (*
 133    Floatl - returns a REAL value corresponding to, i.
 134 *)
 135
 136 PROCEDURE Floatl (i: INTEGER) : LONGREAL ;
 137 BEGIN
 138    RETURN VAL(LONGREAL, i)
 139 END Floatl ;
 140
 141
 142 (*
 143    Truncl - round to the nearest integer not larger in absolute
 144             value.
 145 *)
 146
 147 PROCEDURE Truncl (r: LONGREAL) : LONGINT ;
 148 BEGIN
 149    RETURN VAL(LONGINT, r)
 150 END Truncl ;
 151
 152
 153 END FloatingUtilities.