home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
OSK
/
EFFO
/
forum8.lzh
/
PROGRAMME
/
MODULA
/
WINDOW
/
areaio.mod
< prev
next >
Wrap
Text File
|
1989-01-19
|
27KB
|
849 lines
(*
-------------------------------------------------------------------------------
@@@@@@@@@@@@@@@@@@*) IMPLEMENTATION MODULE AreaIO; (*@@@@@@@@@@@@@@@@@@@@@@
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
| Kurzbeschreibung | formatierte Zahlenausgabe fuer Windowmodul Area |
---------------------+---------------------------------------------------------
| Programm - Version | 2.0 | Text - Version | V#090 |
---------------------+--------+-----------------+-------+----------------------
| Modulholder | WS | Urversion | WS | August 88 |
---------------------+---------------------------------------------------------
| System - Version | OS-9, Miele-Modula-2 3.5 |
---------------------+---------------------------------------------------------
| Copyright | Freigegeben fuer nichtkommerzielle Nutzung |
| | durch Teilnehmer am EFFO |
---------------------+---------------------------------------------------------
| Hardware | GEPARD 68010, 1 MByte RAM, 80Zeichen-Textkarte |
---------------------+---------------------------------------------------------
| besondere Importe | Area |
---------------------+---------------------------------------------------------
| Autoren | WS | Werner Stehling, Seilerwis 3, |
| | | CH-8606 Greifensee, Tel. 01/256 42 21 |
---------------------+---------------------------------------------------------
| U P D A T E S | |
---------------------- |
| Datum Version Autor Bemerkungen |
| -------- ------- ----- ----------- |
| 10. 8.88 1.1 WS dynamische Fensterverwaltung unter GDOS |
| 17. 8.88 1.1 WS Prozeduren zur Zahlenausgabe |
| 12.12.88 2.0 WS Umstellung auf OS-9 |
| 15.12.88 2.0 WS Aufteilung in Area und AreaIO |
| |
-------------------------------------------------------------------------------
| Modul-Beschreibung| siehe Definition Modul |
---------------------- |
-------------------------------------------------------------------------------
*)
FROM SYSTEM IMPORT WORD, ADDRESS, SIZE, ADR;
FROM ConNum IMPORT AddrToStr, StrToAddr;
FROM ConReal IMPORT RealToStr, StrToReal;
FROM Strings IMPORT Concat, Length, Insert, SearchChar, Assign, Delete;
FROM Area IMPORT maxx, CRKey, DelKey, BSKey, HTab, INSKey, UndoKey,
LeftKey, RightKey, DownKey, UpKey, HomeKey, ESCKey,
Write, WriteString, GetXY, GotoXY, GetAreaPar,
DeleteOne, InsertChar, BusyRead;
FROM Math0 IMPORT entier, real;
FROM Math1 IMPORT lg, power;
CONST maxstr = 39;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteStr (s : ARRAY OF CHAR; space : INTEGER);
(*--------------------------------------------------------------------------*)
(* auch alle Zahlenausgaben passieren hier *)
VAR i, k, l : INTEGER;
xc, yc, dx, dy : CARDINAL;
BEGIN
i := 0;
l := 0;
IF space >= 1000 THEN
IF space > 1000 THEN
k := space - 1000 - INTEGER (Length (s))
ELSE
GetXY (xc, yc);
GotoXY (0, yc);
GetAreaPar (NIL, xc, yc, dx, dy);
k := INTEGER (dx) - INTEGER (Length (s))
END;
IF k > 0 THEN
i := k DIV 2;
l := k - i
END
ELSIF space > 0 THEN
i := space - INTEGER (Length (s))
ELSIF space < 0 THEN
l := -space - INTEGER (Length (s))
END;
WHILE i > 0 DO
Write (' ');
i := i - 1
END;
WriteString (s);
WHILE l > 0 DO
Write (' ');
l := l - 1
END;
END WriteStr;
(*--------------------------------------------------------------------------*)
PROCEDURE ZahlStr (val : ADDRESS; base : CARDINAL; digs : INTEGER;
prefix : CHAR; VAR s : ARRAY OF CHAR);
(*--------------------------------------------------------------------------*)
VAR s1 : ARRAY [0..maxstr] OF CHAR;
s2 : ARRAY [0.. 0] OF CHAR;
digits : CARDINAL;
BEGIN
AddrToStr (val, base, s);
s2[0] := '0';
digits := 0;
IF digs > 0 THEN
digits := CARDINAL (digs)
END;
WHILE Length (s) < digits DO
Assign (s, s1);
Concat (s2, s1, s)
END;
IF prefix <> 0C THEN
s2[0] := prefix;
Assign (s, s1);
Concat (s2, s1, s)
END;
END ZahlStr;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteZahl (val : ADDRESS; base : CARDINAL;
digs, space : INTEGER; prefix : CHAR);
(*--------------------------------------------------------------------------*)
VAR s : ARRAY [0..maxstr] OF CHAR;
BEGIN
ZahlStr (val, base, digs, prefix, s);
WriteStr (s, space)
END WriteZahl;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteCard (val : WORD; digs, space : INTEGER);
(*--------------------------------------------------------------------------*)
BEGIN
WriteZahl (ADDRESS (val), 10, digs, space, 0C)
END WriteCard;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteHex (val : WORD; digs, space : INTEGER);
(*--------------------------------------------------------------------------*)
BEGIN
WriteZahl (ADDRESS (val), 16, digs, space, '$')
END WriteHex;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteOct (val : WORD; digs, space : INTEGER);
(*--------------------------------------------------------------------------*)
BEGIN
WriteZahl (ADDRESS (val), 8, digs, space, '&')
END WriteOct;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteBin (val : WORD; digs, space : INTEGER);
(*--------------------------------------------------------------------------*)
BEGIN
WriteZahl (ADDRESS (val), 2, digs, space, '%')
END WriteBin;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteInt (val : INTEGER; digs, space : INTEGER);
(*--------------------------------------------------------------------------*)
VAR s : CHAR;
BEGIN
IF val < 0 THEN
val := -val;
s := '-'
ELSE
s := 0C
END;
WriteZahl (ADDRESS (val), 10, digs, space, s)
END WriteInt;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteLCard (val : ADDRESS; digs, space : INTEGER);
(*--------------------------------------------------------------------------*)
BEGIN
WriteZahl (val, 10, digs, space, 0C)
END WriteLCard;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteLHex (val : ADDRESS; digs, space : INTEGER);
(*--------------------------------------------------------------------------*)
BEGIN
WriteZahl (val, 16, digs, space, '$')
END WriteLHex;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteLBin (val : ADDRESS; digs, space : INTEGER);
(*--------------------------------------------------------------------------*)
BEGIN
WriteZahl (val, 2, digs, space, '%')
END WriteLBin;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteLInt (val : LONGINT; digs, space : INTEGER);
(*--------------------------------------------------------------------------*)
VAR s : CHAR;
BEGIN
IF val < 0 THEN
val := -val;
s := '-'
ELSE
s := 0C
END;
WriteZahl (val, 10, digs, space, s)
END WriteLInt;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteReal (val : REAL; digs, space : INTEGER);
(*--------------------------------------------------------------------------*)
VAR s : ARRAY [0..maxstr] OF CHAR;
BEGIN
RealToStr (val, digs, s);
WriteStr (s, space)
END WriteReal;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteFix (val : REAL; digs, space : INTEGER);
(*--------------------------------------------------------------------------*)
BEGIN
WriteReal (val, ABS (digs), space)
END WriteFix;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteFloat (val : REAL; digs, space : INTEGER);
(*--------------------------------------------------------------------------*)
BEGIN
WriteReal (val, -ABS (digs), space)
END WriteFloat;
(*--------------------------------------------------------------------------*)
PROCEDURE EngPot (VAR val : REAL) : REAL;
(*--------------------------------------------------------------------------*)
VAR i : REAL;
k : INTEGER;
BEGIN
IF val <> 0.0 THEN
i := lg (ABS (val))
ELSE
i := 0.0
END;
IF i >= 0.0 THEN
k := entier (i + 0.5);
k := (k DIV 3) * 3
ELSE
k := entier (-i + 0.5);
k := -(k DIV 3 + 1) * 3
END;
i := real (k);
IF k <> 0 THEN
val := val / power (10.0, i)
END;
RETURN i
END EngPot;
(*--------------------------------------------------------------------------*)
PROCEDURE EngToStr (val : REAL; digs : INTEGER; VAR s : ARRAY OF CHAR);
(*--------------------------------------------------------------------------*)
VAR s1 : ARRAY [0..maxstr] OF CHAR;
se : ARRAY [0..0] OF CHAR;
i : REAL;
k : CARDINAL;
BEGIN
se[0] := 'E';
i := EngPot (val);
RealToStr (val, ABS (digs), s);
IF i <> 0.0 THEN
RealToStr (i, 0, s1);
Insert (se, s, Length (s));
IF i > 0.0 THEN
se[0] := '+';
Insert (se, s, Length (s));
END;
Insert (s1, s, Length (s));
END
END EngToStr;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteEng (val : REAL; digs, space : INTEGER);
(*--------------------------------------------------------------------------*)
VAR s : ARRAY [0..maxstr] OF CHAR;
BEGIN
EngToStr (val, digs, s);
WriteStr (s, space)
END WriteEng;
(*--------------------------------------------------------------------------*)
PROCEDURE OhmToStr (val : REAL; digs : INTEGER; VAR s : ARRAY OF CHAR);
(*--------------------------------------------------------------------------*)
VAR i : REAL;
pos : CARDINAL;
ch : CHAR;
oldval : REAL;
BEGIN
oldval := val;
i := EngPot (val);
IF digs = 0 THEN
digs := 1
END;
RealToStr (val, ABS (digs), s);
CASE entier (i) OF
-18 : ch := 'a' |
-15 : ch := 'f' |
-12 : ch := 'p' |
-9 : ch := 'n' |
-6 : ch := 'u' |
-3 : ch := 'm' |
0 : ch := '.' |
3 : ch := 'K' |
6 : ch := 'M' |
9 : ch := 'G' |
12 : ch := 'T'
ELSE
RealToStr (oldval, -ABS (digs), s);
ch := '.'
END;
IF SearchChar ('.', s, 0, pos) THEN
s[pos] := ch
END;
END OhmToStr;
(*--------------------------------------------------------------------------*)
PROCEDURE WriteOhm (val : REAL; digs, space : INTEGER);
(*--------------------------------------------------------------------------*)
VAR s : ARRAY [0..maxstr] OF CHAR;
BEGIN
OhmToStr (val, digs, s);
WriteStr (s, space)
END WriteOhm;
(*--------------------------------------------------------------------------*)
PROCEDURE ClearField (VAR s : ARRAY OF CHAR; space : CARDINAL);
(*--------------------------------------------------------------------------*)
VAR i, xc, yc, k : CARDINAL;
BEGIN
GetXY (xc, yc);
k := CARDINAL (HIGH (s)) + 1;
IF k > space THEN
k := space
END;
FOR i := 0 TO k - 1 DO
s[i] := 0C
END;
FOR i := 1 TO space DO
Write (' ')
END;
GotoXY (xc, yc)
END ClearField;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadStr (VAR s : ARRAY OF CHAR; space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
VAR xc, len, axc, ayc, spac : CARDINAL;
eoiflag, insertmode : BOOLEAN;
ch : CHAR;
ns : ARRAY [0..maxx] OF CHAR;
x0, y0, dy : CARDINAL;
(*----------------------------------------------------------------------*)
PROCEDURE GotoX (xpos : CARDINAL);
(*----------------------------------------------------------------------*)
BEGIN
xc := xpos;
GotoXY (axc+xc, ayc)
END GotoX;
(*----------------------------------------------------------------------*)
PROCEDURE DeleteChar;
(*----------------------------------------------------------------------*)
VAR i : CARDINAL;
BEGIN
FOR i := xc TO Length (ns) DO
ns[i] := ns[i+1]
END;
DeleteOne
END DeleteChar;
(*----------------------------------------------------------------------*)
PROCEDURE GetChar;
(*----------------------------------------------------------------------*)
VAR ss : ARRAY [0..0] OF CHAR;
BEGIN
ss[0] := ch;
IF insertmode THEN
IF (xc <= Length (ns)) AND (Length (ns) <= len) THEN
InsertChar (1);
Insert (ss, ns, xc);
Write (ch);
INC (xc)
END
ELSE
ns[xc] := ch;
Write (ch);
INC (xc)
END;
END GetChar;
(*----------------------------------------------------------------------*)
PROCEDURE Undo;
(*----------------------------------------------------------------------*)
BEGIN
ClearField (ns, len+1);
ClearField (ns, spac);
Assign (s, ns);
ns[len+1] := 0c;
GotoXY (axc, ayc);
WriteString (ns);
GotoXY (axc, ayc);
END Undo;
(*----------------------------------------------------------------------*)
BEGIN
GetXY (axc, ayc);
spac := ABS (space);
IF spac > 1000 THEN
spac := spac - 1000
ELSIF spac = 1000 THEN
axc := 0;
GotoXY (axc, ayc);
GetAreaPar (NIL, x0, y0, spac, dy)
END;
ClearField (ns, spac);
len := spac - 1;
Assign (s, ns);
WriteString (ns);
GotoX (0);
eoiflag := FALSE;
insertmode := FALSE;
REPEAT
BusyRead (ch);
CASE ch OF
DelKey : DeleteChar |
BSKey : IF xc > 0 THEN
GotoX (xc-1); DeleteChar
END |
INSKey : insertmode := NOT (insertmode) |
LeftKey : IF xc > 0 THEN
GotoX (xc-1)
END |
RightKey : IF (xc < len) AND (xc < Length (ns)) THEN
GotoX (xc+1)
END |
DownKey,
UpKey,
CRKey : eoiflag := TRUE |
ESCKey : Undo;
eoiflag := TRUE |
HomeKey : ClearField (ns, len+1) |
UndoKey : Undo;
ELSE
IF (xc >= 0) AND (xc <= len) THEN
GetChar
END
END
UNTIL eoiflag;
Assign (ns, s);
GotoX (0);
WriteStr (s, space);
RETURN ch
END ReadStr;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadAddress (VAR val : ADDRESS; digs, space : INTEGER;
base: CARDINAL) : CHAR;
(*--------------------------------------------------------------------------*)
VAR s : ARRAY [0..maxstr] OF CHAR;
ch, prefix : CHAR;
axc, ayc, nbase, lens : CARDINAL;
ok : BOOLEAN;
nval : ADDRESS;
nspac : INTEGER;
BEGIN
GetXY (axc, ayc);
REPEAT
CASE base OF
2 : prefix := '%' |
8 : prefix := '&' |
10 : prefix := 0C |
16 : prefix := '$'
END;
ZahlStr (val, base, digs, prefix, s);
IF space > 1000 THEN
nspac := 1000 - space
ELSE
nspac := -ABS (space)
END;
IF INTEGER (Length (s)) > -nspac THEN
nspac := -INTEGER (Length (s))
END;
ch := ReadStr (s, nspac);
WHILE (s[0] <> 0C) AND (s[0] <= ' ') DO
Delete (s, 0, 1)
END;
lens := Length (s) - 1;
WHILE (s[0] <> 0C) AND (s[lens] <= ' ') DO
Delete (s, lens, 1);
lens := Length (s) - 1
END;
CASE s[0] OF
'%' : Delete (s, 0, 1); nbase := 2 |
'&' : Delete (s, 0, 1); nbase := 8 |
'$' : Delete (s, 0, 1); nbase := 16
ELSE
nbase := 10;
END;
nval := 0;
ok := TRUE;
IF Length (s) > 0 THEN
StrToAddr (s, nbase, nval, ok)
END;
GotoXY (axc, ayc)
UNTIL ok;
val := nval;
WriteZahl (val, base, digs, space, prefix);
RETURN ch
END ReadAddress;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadWord (VAR val : WORD; digs, space : INTEGER;
base: CARDINAL) : CHAR;
(*--------------------------------------------------------------------------*)
VAR ch : CHAR;
lval: ADDRESS;
BEGIN
lval := ADDRESS (val);
ch := ReadAddress (lval, digs, space, base);
val := WORD (lval);
RETURN ch
END ReadWord;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadCard (VAR val : WORD; digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
BEGIN
RETURN ReadWord (val, digs, space, 10)
END ReadCard;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadHex (VAR val : WORD; digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
BEGIN
RETURN ReadWord (val, digs, space, 16)
END ReadHex;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadOct (VAR val : WORD; digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
BEGIN
RETURN ReadWord (val, digs, space, 8)
END ReadOct;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadBin (VAR val : WORD; digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
BEGIN
RETURN ReadWord (val, digs, space, 2)
END ReadBin;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadInt (VAR val : INTEGER; digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
VAR ch : CHAR;
lval: LONGINT;
BEGIN
lval := LONGINT (val);
ch := ReadLInt (lval, digs, space);
val := WORD (lval);
RETURN ch
END ReadInt;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadLCard (VAR val : ADDRESS; digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
BEGIN
RETURN ReadAddress (val, digs, space, 10)
END ReadLCard;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadLHex (VAR val : ADDRESS; digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
BEGIN
RETURN ReadAddress (val, digs, space, 16)
END ReadLHex;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadLBin (VAR val : ADDRESS; digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
BEGIN
RETURN ReadAddress (val, digs, space, 2)
END ReadLBin;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadLInt (VAR val : LONGINT; digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
VAR s : ARRAY [0..maxstr] OF CHAR;
ch, prefix, nsig : CHAR;
axc, ayc, nbase, lens : CARDINAL;
ok : BOOLEAN;
nval : ADDRESS;
nspac : INTEGER;
BEGIN
GetXY (axc, ayc);
REPEAT
IF val < 0 THEN
prefix := '-';
nval := ADDRESS (-val)
ELSE
prefix := 0C;
nval := ADDRESS (val)
END;
ZahlStr (nval, 10, digs, prefix, s);
IF space > 1000 THEN
nspac := 1000 - space
ELSE
nspac := -ABS (space)
END;
IF INTEGER (Length (s)) > -nspac THEN
nspac := -INTEGER (Length (s))
END;
ch := ReadStr (s, nspac);
WHILE (s[0] <> 0C) AND (s[0] <= ' ') DO
Delete (s, 0, 1)
END;
lens := Length (s) - 1;
WHILE (s[0] <> 0C) AND (s[lens] <= ' ') DO
Delete (s, lens, 1);
lens := Length (s) - 1
END;
IF s[0] = '-' THEN
Delete (s, 0, 1);
nsig := '-'
ELSIF s[0] = '+' THEN
Delete (s, 0, 1);
nsig := 0C
ELSE
nsig := 0C
END;
nval := 0;
ok := TRUE;
IF Length (s) > 0 THEN
StrToAddr (s, 10, nval, ok);
END;
GotoXY (axc, ayc)
UNTIL ok;
IF nsig = '-' THEN
val := -LONGINT (nval)
ELSE
val := LONGINT (nval)
END;
WriteZahl (nval, 10, digs, space, nsig);
RETURN ch
END ReadLInt;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadFix (VAR val : REAL; digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
BEGIN
RETURN ReadReal (val, ABS (digs), space)
END ReadFix;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadFloat (VAR val : REAL; digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
BEGIN
RETURN ReadReal (val, -ABS (digs), space)
END ReadFloat;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadRealS (VAR val : REAL; VAR s : ARRAY OF CHAR;
digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
VAR ch : CHAR;
axc, ayc, lens : CARDINAL;
ok : BOOLEAN;
nval : REAL;
nspac : INTEGER;
s1 : ARRAY [0..maxstr] OF CHAR;
BEGIN
GetXY (axc, ayc);
REPEAT
IF space > 1000 THEN
nspac := 1000 - space
ELSE
nspac := -ABS (space)
END;
IF INTEGER (Length (s)) > -nspac THEN
nspac := -INTEGER (Length (s))
END;
ch := ReadStr (s, nspac);
WHILE (s[0] <> 0C) AND (s[0] <= ' ') DO
Delete (s, 0, 1)
END;
lens := Length (s) - 1;
WHILE (s[0] <> 0C) AND (s[lens] <= ' ') DO
Delete (s, lens, 1);
lens := Length (s) - 1
END;
StrToReal (s, nval, ok);
IF NOT ok THEN
Assign (s, s1);
StrToOhm (s1, nval, ok)
END;
GotoXY (axc, ayc)
UNTIL ok;
val := nval;
RETURN ch
END ReadRealS;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadReal (VAR val : REAL; digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
VAR s : ARRAY [0..maxstr] OF CHAR;
ch : CHAR;
BEGIN
RealToStr (val, digs, s);
ch := ReadRealS (val, s, digs, space);
WriteReal (val, digs, space);
RETURN ch
END ReadReal;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadEng (VAR val : REAL; digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
VAR s : ARRAY [0..maxstr] OF CHAR;
ch : CHAR;
BEGIN
EngToStr (val, digs, s);
ch := ReadRealS (val, s, digs, space);
WriteEng (val, digs, space);
RETURN ch
END ReadEng;
(*--------------------------------------------------------------------------*)
PROCEDURE StrToOhm (VAR s : ARRAY OF CHAR; VAR val : REAL;
VAR ok : BOOLEAN);
(*--------------------------------------------------------------------------*)
VAR pos : CARDINAL;
(*----------------------------------------------------------------------*)
PROCEDURE OhmConv (VAR s, exp : ARRAY OF CHAR);
(*----------------------------------------------------------------------*)
BEGIN
s[pos] := '.';
Concat (s, exp, s)
END OhmConv;
(*----------------------------------------------------------------------*)
BEGIN
IF SearchChar ('a', s, 0, pos) THEN
OhmConv (s, 'E-18')
ELSIF SearchChar ('f', s, 0, pos) THEN
OhmConv (s, 'E-15')
ELSIF SearchChar ('p', s, 0, pos) THEN
OhmConv (s, 'E-12')
ELSIF SearchChar ('n', s, 0, pos) THEN
OhmConv (s, 'E-9')
ELSIF SearchChar ('u', s, 0, pos) THEN
OhmConv (s, 'E-6')
ELSIF SearchChar ('m', s, 0, pos) THEN
OhmConv (s, 'E-3')
ELSIF SearchChar ('K', s, 0, pos) THEN
OhmConv (s, 'E+3')
ELSIF SearchChar ('M', s, 0, pos) THEN
OhmConv (s, 'E+6')
ELSIF SearchChar ('G', s, 0, pos) THEN
OhmConv (s, 'E+9')
ELSIF SearchChar ('T', s, 0, pos) THEN
OhmConv (s, 'E+12')
END;
StrToReal (s, val, ok)
END StrToOhm;
(*--------------------------------------------------------------------------*)
PROCEDURE ReadOhm (VAR val : REAL; digs, space : INTEGER) : CHAR;
(*--------------------------------------------------------------------------*)
VAR s : ARRAY [0..maxstr] OF CHAR;
ch : CHAR;
BEGIN
OhmToStr (val, digs, s);
ch := ReadRealS (val, s, digs, space);
WriteOhm (val, digs, space);
RETURN ch
END ReadOhm;
(*--------------------------------------------------------------------------*)
BEGIN
END AreaIO.
