]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* ConvStringReal.mod translate floating point numbers to Strings. |
2 | ||
a945c346 | 3 | Copyright (C) 2009-2024 Free Software Foundation, Inc. |
1eee94d3 GM |
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 ConvStringReal ; | |
28 | ||
29 | FROM DynamicStrings IMPORT InitString, KillString, ConCat, ConCatChar, | |
30 | Slice, Length, Mult, Mark, InitStringCharStar, | |
31 | InitStringChar, Index, char ; | |
32 | FROM StringConvert IMPORT IntegerToString, ToSigFig ; | |
33 | FROM dtoa IMPORT dtoa, Mode ; | |
34 | FROM libc IMPORT free, printf ; | |
35 | FROM SYSTEM IMPORT ADDRESS ; | |
36 | ||
37 | CONST | |
38 | Debugging = FALSE ; | |
39 | ||
40 | ||
41 | (* | |
42 | IsDigit - returns TRUE if, ch, lies between '0'..'9'. | |
43 | *) | |
44 | ||
45 | PROCEDURE IsDigit (ch: CHAR) : BOOLEAN ; | |
46 | BEGIN | |
47 | RETURN (ch>='0') AND (ch<='9') | |
48 | END IsDigit ; | |
49 | ||
50 | ||
51 | (* | |
52 | RealToFloatString - converts a real with, sigFigs, into a string | |
53 | and returns the result as a string. | |
54 | *) | |
55 | ||
56 | PROCEDURE RealToFloatString (real: REAL; sigFigs: CARDINAL) : String ; | |
57 | VAR | |
58 | point, l, | |
59 | powerOfTen: INTEGER ; | |
60 | s : String ; | |
61 | r : ADDRESS ; | |
62 | sign : BOOLEAN ; | |
63 | BEGIN | |
64 | r := dtoa(real, maxsignificant, 100, point, sign) ; | |
65 | s := InitStringCharStar(r) ; | |
66 | free(r) ; | |
67 | IF sigFigs>0 | |
68 | THEN | |
69 | l := Length(s) ; | |
70 | IF (l>0) AND IsDigit(char(s, 0)) | |
71 | THEN | |
72 | IF VAL(INTEGER, sigFigs)<l | |
73 | THEN | |
74 | s := Slice(ToSigFig(s, sigFigs), 0, sigFigs) | |
75 | ELSE | |
76 | (* add '0's to make up significant figures *) | |
77 | s := ConCat(s, Mark(Mult(InitStringChar('0'), l-VAL(INTEGER, sigFigs)))) | |
78 | END ; | |
79 | l := Length(s) ; | |
80 | (* | |
81 | * we reassign point to 1 and adjust the exponent | |
82 | * accordingly, so we can achieve the format X.XXXE+X | |
83 | *) | |
84 | powerOfTen := point-1 ; | |
85 | point := 1 ; | |
86 | ||
87 | IF (point<l) AND (point<VAL(INTEGER, sigFigs)) | |
88 | THEN | |
89 | s := ConCat(ConCatChar(Slice(s, 0, point), '.'), | |
90 | Slice(s, point, 0)) | |
91 | END ; | |
92 | ||
93 | IF powerOfTen#0 | |
94 | THEN | |
95 | s := ConCat(ConCatChar(s, 'E'), | |
96 | IntegerToString(powerOfTen, 0, ' ', TRUE, 10, FALSE)) | |
97 | END | |
98 | END ; | |
99 | IF sign | |
100 | THEN | |
101 | s := ConCat(InitStringChar('-'), Mark(s)) | |
102 | END | |
103 | END ; | |
104 | RETURN( s ) | |
105 | END RealToFloatString ; | |
106 | ||
107 | ||
108 | (* | |
109 | RealToEngString - converts the value of real to floating-point | |
110 | string form, with sigFigs significant figures. | |
111 | The number is scaled with one to three digits | |
112 | in the whole number part and with an exponent | |
113 | that is a multiple of three. | |
114 | *) | |
115 | ||
116 | PROCEDURE RealToEngString (real: REAL; sigFigs: CARDINAL) : String ; | |
117 | VAR | |
118 | offset, | |
119 | point, | |
120 | powerOfTen: INTEGER ; | |
121 | s : String ; | |
122 | l : CARDINAL ; | |
123 | r : ADDRESS ; | |
124 | sign : BOOLEAN ; | |
125 | BEGIN | |
126 | r := dtoa(real, maxsignificant, 100, point, sign) ; | |
127 | s := InitStringCharStar(r) ; | |
128 | free(r) ; | |
129 | IF sigFigs>0 | |
130 | THEN | |
131 | l := Length(s) ; | |
132 | IF (l>0) AND IsDigit(char(s, 0)) | |
133 | THEN | |
134 | IF sigFigs<l | |
135 | THEN | |
136 | s := Slice(ToSigFig(s, sigFigs), 0, sigFigs) | |
137 | ELSE | |
138 | (* add '0's to make up significant figures *) | |
139 | s := ConCat(s, Mark(Mult(InitStringChar('0'), l-sigFigs))) | |
140 | END ; | |
141 | l := Length(s) ; | |
142 | IF (point>0) AND (point<=2) | |
143 | THEN | |
144 | (* current range is fine, no need for a exponent *) | |
145 | powerOfTen := 0 ; | |
146 | IF point>VAL(INTEGER, sigFigs) | |
147 | THEN | |
148 | (* add '0's to make up required mantissa length *) | |
149 | s := ConCat(s, Mark(Mult(InitStringChar('0'), point-VAL(INTEGER, sigFigs)))) ; | |
150 | l := Length(s) | |
151 | END | |
152 | ELSE | |
153 | (* | |
154 | * desire a value of point which lies between 1..3 | |
155 | * this allows the mantissa to have the format | |
156 | * X.XXX or XX.XX or XXX.X | |
157 | *) | |
158 | powerOfTen := point-VAL(INTEGER, l) ; | |
159 | point := point-powerOfTen ; | |
160 | offset := 0 ; | |
161 | IF point>3 | |
162 | THEN | |
163 | offset := (point DIV 3) * 3 ; | |
164 | point := point-offset ; | |
165 | powerOfTen := powerOfTen+offset | |
166 | ELSIF point<0 | |
167 | THEN | |
168 | offset := (ABS(point) DIV 3) * 3 ; | |
169 | point := point+offset ; | |
170 | powerOfTen := powerOfTen-offset | |
171 | END ; | |
172 | IF powerOfTen<0 | |
173 | THEN | |
174 | IF ABS(powerOfTen) MOD 3#0 | |
175 | THEN | |
176 | offset := 3-(ABS(powerOfTen) MOD 3) | |
177 | END | |
178 | ELSE | |
179 | (* at this stage, point >= sigFigs *) | |
180 | IF powerOfTen MOD 3#0 | |
181 | THEN | |
182 | offset := -(3-(powerOfTen MOD 3)) | |
183 | END | |
184 | END ; | |
185 | IF offset+point>VAL(INTEGER, sigFigs) | |
186 | THEN | |
187 | (* add '0's to make up required mantissa length *) | |
188 | s := ConCat(s, Mark(Mult(InitStringChar('0'), offset+point-VAL(INTEGER, sigFigs)))) ; | |
189 | l := Length(s) | |
190 | END ; | |
191 | (* now adjust point and powerOfTen by offset *) | |
192 | point := point + offset ; | |
193 | powerOfTen := powerOfTen - offset | |
194 | END ; | |
195 | ||
196 | IF point<0 | |
197 | THEN | |
198 | s := ConCat(ConCat(InitString('0.'), Mult(InitStringChar('0'), -point)), s) | |
199 | ELSIF (point>0) AND (point<VAL(INTEGER, l)) AND (point<VAL(INTEGER, sigFigs)) | |
200 | THEN | |
201 | s := ConCat(ConCatChar(Slice(s, 0, point), '.'), | |
202 | Slice(s, point, 0)) | |
203 | END ; | |
204 | ||
205 | IF powerOfTen#0 | |
206 | THEN | |
207 | s := ConCat(ConCatChar(s, 'E'), | |
208 | IntegerToString(powerOfTen, 0, ' ', TRUE, 10, FALSE)) | |
209 | END | |
210 | END ; | |
211 | IF sign | |
212 | THEN | |
213 | s := ConCat(InitStringChar('-'), Mark(s)) | |
214 | END | |
215 | END ; | |
216 | RETURN( s ) | |
217 | END RealToEngString ; | |
218 | ||
219 | ||
220 | (* | |
221 | RealToFixedString - returns the number of characters in the fixed-point | |
222 | string representation of real rounded to the given | |
223 | place relative to the decimal point. | |
224 | *) | |
225 | ||
226 | PROCEDURE RealToFixedString (real: REAL; place: INTEGER) : String ; | |
227 | VAR | |
228 | l, | |
229 | point: INTEGER ; | |
230 | sign : BOOLEAN ; | |
231 | r : ADDRESS ; | |
232 | s : String ; | |
233 | BEGIN | |
234 | r := dtoa(real, maxsignificant, 100, point, sign) ; | |
235 | s := InitStringCharStar(r) ; | |
236 | free(r) ; | |
237 | l := Length(s) ; | |
238 | IF Debugging | |
239 | THEN | |
240 | printf("length of string returned is %d decimal point at position %d\n", l, point) | |
241 | END ; | |
242 | IF (l>0) AND IsDigit(char(s, 0)) | |
243 | THEN | |
244 | IF point+place>=0 | |
245 | THEN | |
246 | (* add decimal point at correct position *) | |
247 | IF point<0 | |
248 | THEN | |
249 | s := ConCat(ConCat(InitString('0.'), Mult(InitStringChar('0'), -point)), s) | |
250 | ELSIF point=0 | |
251 | THEN | |
252 | s := ConCat(InitString('0.'), Mark(s)) | |
253 | ELSIF point<l | |
254 | THEN | |
255 | s := ConCat(ConCatChar(Slice(s, 0, point), '.'), | |
256 | Slice(s, point, 0)) | |
257 | END ; | |
258 | IF place<0 | |
259 | THEN | |
260 | s := ToSigFig(s, point+place+1) | |
261 | ELSE | |
262 | s := ToSigFig(s, point+place) | |
263 | END ; | |
264 | l := Length(s) ; | |
265 | IF place>=0 | |
266 | THEN | |
267 | IF Index(s, '.', 0)<0 | |
268 | THEN | |
269 | s := ConCatChar(s, '.') ; | |
270 | s := ConCat(s, Mark(Mult(InitStringChar('0'), place))) | |
271 | ELSE | |
272 | point := Index(s, '.', 0) ; | |
273 | IF l-point<place | |
274 | THEN | |
275 | s := ConCat(s, Mark(Mult(InitStringChar('0'), l-point-place))) | |
276 | END | |
277 | END | |
278 | END | |
279 | ELSE | |
280 | IF place<0 | |
281 | THEN | |
282 | s := InitString('0') | |
283 | ELSIF place=0 | |
284 | THEN | |
285 | s := InitString('0.') | |
286 | ELSE | |
287 | s := InitString('0.0') | |
288 | END | |
289 | END | |
290 | END ; | |
291 | IF sign | |
292 | THEN | |
293 | s := ConCat(InitStringChar('-'), Mark(s)) | |
294 | END ; | |
295 | RETURN( s ) | |
296 | END RealToFixedString ; | |
297 | ||
298 | ||
299 | END ConvStringReal. |