(*
** PROGRAM TITLE: Alpha Numeric Numbers Conversions
**
** WRITTEN BY: Raymond E. Penley
** DATE WRITTEN: 5 July 1980
**
** SUMMARY:
**
** VAL = Single character to integer value.
** RDR = Alphanumeric to real number.
** STR = Integer to alphanumeric.
**
** Donated to PASCAL/Z USERS GROUP, July 1980
**
*)
const default = 80; { Default length }
(*------------------------------------------*)
Function VAL(ch: char): integer;
{ Returns the integer value of
the single char passed }
const z = 48; { ORD('0') }
begin
VAL := ORD(ch) - z
end;
(*------------------------------------------*)
Function RDR(var f: Dstring ): real;
{ read real numbers in free format.
author: Niklaus Wirth
book: Pascal User Manual & Report
pg 122-123
ENTER WITH:
f = a string containing ONLY the alphanumeric number
to be converted to a real number.
RETURNS:
A real number.
Any error returns RDR := 0.0
*}
label 9;{ error exit }
const
t48 = 281474976710656.0 ;
limit = 56294995342131.0 ;
lim1 = 322; { maximum exponent }
lim2 = -292; { minimum exponent }
space = ' ';
emsg1 = '**digit expected';
emsg2 = '**number too large';
type
posint = 0..323;
var
ch : char;
y : real;
posn,
a,i,e : integer;
fatal,
s,ss : boolean; { signs }
function TEN(e: posint): real; { = 10**e, 0<e<322 }
var i: integer;
t: real;
begin
i := 0;
t := 1.0;
repeat
If ODD(e) then
case i of
0: t := t * 1.0E1;
1: t := t * 1.0E2;
2: t := t * 1.0E4;
3: t := t * 1.0E8;
4: t := t * 1.0E16;
5: t := t * 1.0E32 { that's all! }
6,7,8:
begin
writeln('**Floating point overflow');
fatal := true;
e := 2;{ sets e to zero on next division }
end;
{*===================*
--- can not use ---
6: t := t * 1.0E64;
7: t := t * 1.0E128;
8: t := t * 1.0E256
*===================*}
end{ case };
e := e DIV 2;
i := i + 1;
until e=0;
TEN := t;
end{of TEN};
begin
fatal := false;
posn := length(f);
setlength(f,posn+1);
f[posn+1] := space;
posn := 0;
getc(ch);
{ skip leading blanks }
While ch=space do getc(ch);
If ch='-' then
begin
s := true;
getc(ch)
end
Else
begin
s := false;
If ch='+' then getc(ch)
end;
If not(ch IN ['0'..'9']) then
begin
writeln(emsg1);
{HALT} fatal := true; goto 9;
end;
a := 0;
e := 0;
repeat
If a<limit then
a := 10 * a + VAL(ch)
Else
e := e+1;
getc(ch);
until not(ch IN ['0'..'9']);
If ch='.' then
begin { read fraction }
getc(ch);
while ch IN ['0'..'9'] do
begin
If a<limit then
begin
a := 10 * a + VAL(ch);
e := e - 1
end;
getc(ch);
end{ while };
end{ read fraction };
If (ch='E') or (CH='e') then
begin { read scale factor }
getc(ch);
i := 0;
If ch='-' then
begin ss := true; getc(ch) end
Else
begin
ss := false;
If ch='+' then getc(ch)
end;
If ch IN ['0'..'9'] then
begin
i := VAL(ch);
getc(ch);
while ch IN ['0'..'9'] do
begin
If i<limit then i := 10 * i + VAL(ch);
getc(ch)
end{ while}
end{ If }
Else
begin
writeln(emsg1);
{HALT} fatal := true; goto 9;
end;
If ss
then e := e - i
Else e := e + i;
end{ read scale factor };
If e < lim2 then
begin
a := 0;
e := 0;
end
Else
If e > lim1 then
begin
writeln(emsg2);
{HALT} fatal := true; goto 9;
end;
{ 0 < a < 2**49 }
If a >= t48 then
y := ((a+1) DIV 2) * 2.0
Else
y := a;
If s then y := -y;
If e < 0 then
RDR := y/TEN(-e)
Else
If e<>0 then
RDR := y*TEN(e)
Else
RDR := y;
9: If fatal then RDR := 0.0;
End{of RDR};
(*------------------------------------------*)
Procedure STR( var S: Dstring;
tval: integer );
{ ENTER WITH:
tval = INTEGER to be converted to an alphanumeric
string.
RETURNS:
An alphanumeric equal of tval in S.
}
const
size = 15; { number of digits in the number }
var
cix : char;
digits : packed array[1..10] of char;
i, { length of number }
d,t,j: integer;
begin
digits := '0123456789';
t := ABS(tval);
setlength(S,0); { null string }
i := 0;
repeat { generate digits }
i := i + 1;
d := t MOD 10;
append(S,digits[d+1]);
t := t DIV 10
until (t=0) OR (i>=size);
If (tval<0) AND (i<size) then
begin { sign }
i := i + 1;
append(S,'-')
end;
j := 1;
while j<i do
begin{ reverse }
cix := S[i]; S[i] := S[j]; S[j] := cix;
i := i - 1;
j := j + 1
end{ revese }
End{of STR};
begin
done := false;
repeat
writeln;
write('Enter a number (real or integer) ?');
readln(answer);
writeln('literal number is ..... ', answer);
writeln('with a length of ..... ', length(answer):4 );
zx := RDR(answer);
writeln('the numeric equal of your literal .. ', zx);
writeln('Formatted as ! Number:10:4 ! ....... ', zx:10:4);
write('Five times ', zx, ' = ');writeln( zx * 5 );
write('The integer portion is ............... ');writeln( trunc(zx) );
writeln;
write('Enter an integer ?');
readln(number);
STR(answer, number);
writeln('The integer number is .............. ', number);
writeln('Expressed as an alphanumeric is .... ', answer);
writeln('the length of the literal is ....... ', length(answer) );
append(answer,answer);
writeln('Since we now have a string');
writeln(' we can concatenate like so ........ ', answer);
Until done;
End{ of Alpha_Numeric }.
