1 (* NumberIO.mod provides conversion of ordinal numbers.
3 Copyright (C) 2001-2024 Free Software Foundation, Inc.
4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
6 This file is part of GNU Modula-2.
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)
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.
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.
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/>. *)
27 IMPLEMENTATION MODULE NumberIO
;
30 FROM ASCII
IMPORT nul
;
31 FROM StrIO
IMPORT ReadString
, WriteString
, WriteLn
;
32 FROM StrLib
IMPORT StrLen
, StrRemoveWhitePrefix
;
43 PROCEDURE CardToStr (x
, n
: CARDINAL ; VAR a
: ARRAY OF CHAR) ;
47 buf
: ARRAY [1..MaxDigits
] OF CARDINAL ;
54 WriteString('NumberIO - increase MaxDigits') ; WriteLn
;
62 WHILE (n
>i
) AND (j
<=Higha
) DO
67 WHILE (i
>0) AND (j
<=Higha
) DO
68 a
[j
] := CHR( buf
[i
] + ORD('0') ) ;
79 PROCEDURE StrToCard (a
: ARRAY OF CHAR ; VAR x
: CARDINAL) ;
85 StrRemoveWhitePrefix(a
, a
) ;
92 IF (a
[i
]<'0') OR (a
[i
]>'9')
107 x
:= 10*x
+ (ORD(a
[i
])-ORD('0')) ;
111 IF (a
[i
]<'0') OR (a
[i
]>'9')
123 PROCEDURE IntToStr (x
: INTEGER; n
: CARDINAL ; VAR a
: ARRAY OF CHAR) ;
127 buf
: ARRAY [1..MaxDigits
] OF CARDINAL ;
133 c
:= VAL(CARDINAL, ABS(x
+1))+1 ;
147 WriteString('NumberIO - increase MaxDigits') ; WriteLn
;
155 WHILE (n
>i
) AND (j
<=Higha
) DO
165 WHILE (i#
0) AND (j
<=Higha
) DO
166 a
[j
] := CHR( buf
[i
] + ORD('0') ) ;
177 PROCEDURE StrToInt (a
: ARRAY OF CHAR ; VAR x
: INTEGER) ;
184 StrRemoveWhitePrefix(a
, a
) ;
195 Negative
:= NOT Negative
196 ELSIF (a
[i
]<'0') OR (a
[i
]>'9')
213 x
:= 10*x
- INTEGER(ORD(a
[i
])-ORD('0'))
215 x
:= 10*x
+ INTEGER(ORD(a
[i
])-ORD('0'))
220 IF (a
[i
]<'0') OR (a
[i
]>'9')
232 PROCEDURE HexToStr (x
, n
: CARDINAL ; VAR a
: ARRAY OF CHAR) ;
236 buf
: ARRAY [1..MaxHexDigits
] OF CARDINAL ;
243 WriteString('NumberIO - increase MaxDigits') ; WriteLn
;
246 buf
[i
] := x
MOD 010H
;
251 WHILE (n
>i
) AND (j
<=Higha
) DO
256 WHILE (i#
0) AND (j
<=Higha
) DO
259 a
[j
] := CHR( buf
[i
] + ORD('0') )
261 a
[j
] := CHR( buf
[i
] + ORD('A')-10 )
273 PROCEDURE StrToHex (a
: ARRAY OF CHAR ; VAR x
: CARDINAL) ;
278 x
:= VAL(CARDINAL, i
)
282 PROCEDURE StrToHexInt (a
: ARRAY OF CHAR ; VAR x
: INTEGER) ;
288 StrRemoveWhitePrefix(a
, a
) ;
295 IF ((a
[i
]>='0') AND (a
[i
]<='9')) OR ((a
[i
]>='A') AND (a
[i
]<='F'))
310 IF (a
[i
]>='0') AND (a
[i
]<='9')
312 x
:= 010H
*x
+ VAL(INTEGER, (ORD(a
[i
])-ORD('0')))
313 ELSIF (a
[i
]>='A') AND (a
[i
]<='F')
315 x
:= 010H
*x
+ VAL(INTEGER, (ORD(a
[i
])-ORD('A')+10))
320 IF ((a
[i
]<'0') OR (a
[i
]>'9')) AND ((a
[i
]<'A') OR (a
[i
]>'F'))
332 PROCEDURE OctToStr (x
, n
: CARDINAL ; VAR a
: ARRAY OF CHAR) ;
336 buf
: ARRAY [1..MaxOctDigits
] OF CARDINAL ;
343 WriteString('NumberIO - increase MaxDigits') ; WriteLn
;
351 WHILE (n
>i
) AND (j
<=Higha
) DO
356 WHILE (i
>0) AND (j
<=Higha
) DO
357 a
[j
] := CHR( buf
[i
] + ORD('0') ) ;
368 PROCEDURE StrToOct (a
: ARRAY OF CHAR ; VAR x
: CARDINAL) ;
373 x
:= VAL(CARDINAL, i
)
377 PROCEDURE StrToOctInt (a
: ARRAY OF CHAR ; VAR x
: INTEGER) ;
383 StrRemoveWhitePrefix(a
, a
) ;
390 IF (a
[i
]<'0') OR (a
[i
]>'7')
405 x
:= 8*x
+ VAL(INTEGER, (ORD(a
[i
])-ORD('0'))) ;
409 IF (a
[i
]<'0') OR (a
[i
]>'7')
421 PROCEDURE BinToStr (x
, n
: CARDINAL ; VAR a
: ARRAY OF CHAR) ;
425 buf
: ARRAY [1..MaxBits
] OF CARDINAL ;
432 WriteString('NumberIO - increase MaxBits') ; WriteLn
;
440 WHILE (n
>i
) AND (j
<=Higha
) DO
445 WHILE (i
>0) AND (j
<=Higha
) DO
446 a
[j
] := CHR( buf
[i
] + ORD('0') ) ;
457 PROCEDURE StrToBin (a
: ARRAY OF CHAR ; VAR x
: CARDINAL) ;
462 x
:= VAL(CARDINAL, i
)
466 PROCEDURE StrToBinInt (a
: ARRAY OF CHAR ; VAR x
: INTEGER) ;
472 StrRemoveWhitePrefix(a
, a
) ;
479 IF (a
[i
]<'0') OR (a
[i
]>'1')
494 x
:= 2*x
+ VAL(INTEGER, (ORD(a
[i
])-ORD('0'))) ;
498 IF (a
[i
]<'0') OR (a
[i
]>'1')
510 PROCEDURE ReadOct (VAR x
: CARDINAL) ;
512 a
: ARRAY [0..MaxLineLength
] OF CHAR ;
519 PROCEDURE WriteOct (x
, n
: CARDINAL) ;
521 a
: ARRAY [0..MaxLineLength
] OF CHAR ;
523 OctToStr( x
, n
, a
) ;
528 PROCEDURE ReadBin (VAR x
: CARDINAL) ;
530 a
: ARRAY [0..MaxLineLength
] OF CHAR ;
537 PROCEDURE WriteBin (x
, n
: CARDINAL) ;
539 a
: ARRAY [0..MaxLineLength
] OF CHAR ;
541 BinToStr( x
, n
, a
) ;
546 PROCEDURE ReadCard (VAR x
: CARDINAL) ;
548 a
: ARRAY [0..MaxLineLength
] OF CHAR ;
555 PROCEDURE WriteCard (x
, n
: CARDINAL) ;
557 a
: ARRAY [0..MaxLineLength
] OF CHAR ;
559 CardToStr( x
, n
, a
) ;
564 PROCEDURE ReadInt (VAR x
: INTEGER) ;
566 a
: ARRAY [0..MaxLineLength
] OF CHAR ;
573 PROCEDURE WriteInt (x
: INTEGER; n
: CARDINAL) ;
575 a
: ARRAY [0..MaxLineLength
] OF CHAR ;
577 IntToStr( x
, n
, a
) ;
582 PROCEDURE ReadHex (VAR x
: CARDINAL) ;
584 a
: ARRAY [0..MaxLineLength
] OF CHAR ;
591 PROCEDURE WriteHex (x
, n
: CARDINAL) ;
593 a
: ARRAY [0..MaxLineLength
] OF CHAR ;
595 HexToStr( x
, n
, a
) ;