home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Whiteline: Alpha
/
Whiteline Alpha.iso
/
progtool
/
modula2
/
hk_lib
/
def_mod
/
converts.mod
< prev
next >
Encoding:
Amiga
Atari
Commodore
DOS
FM Towns/JPY
Macintosh
Macintosh JP
Macintosh to JP
NeXTSTEP
RISC OS/Acorn
Shift JIS
UTF-8
Wrap
Modula Implementation
|
1994-09-22
|
32.1 KB
|
1,001 lines
IMPLEMENTATION MODULE ConvertStr;
(*****************************************************************************)
(*___________________________________________________________________________*)
(* 05-Jan-90 , hk *)
(* Beginn *)
(* 24-Jan-90 , hk *)
(* erste Version *)
(* 03-Feb-90 , hk *)
(* "LastResult" neu *)
(* 12-Feb-90 , hk *)
(* hinter den Stringrepraesentationen der zu wandelnden Werte koennen *)
(* beliebige Begrenzungszeichen stehen ( "Chars.IsDelimiter" ), *)
(* automatischer Fehlerreport, "NextIndex" neu. *)
(*****************************************************************************)
FROM SYSTEM IMPORT (* TYPE *) BYTE, WORD,
(* PROC *) SHORT, LONG, VAL, SHIFT, INLINE;
FROM Chars IMPORT (* TYPE *) CharClassTest,
(* PROC *) CardToDigit, DigitToCard,
CardToHexDigit, HexDigitToCard,
IsBinDigit, IsDigit, IsOctDigit, IsHexDigit,
IsGraphic, IsDelimiter;
(*===========================================================================*)
(*== LOKAL ==================================================================*)
VAR lastResult : ConvertResult;
Convhandler : ConvHandler;
handlerOn : BOOLEAN;
aktProc : ARRAY [0..13] OF CHAR;
nextIdx : INTEGER;
(*---------------------------------------------------------------------------*)
PROCEDURE emptyConvHandler ((* EIN/ -- *) proc : ARRAY OF CHAR;
(* EIN/ -- *) error : ConvertResult );
(*T*)
(* nur damit das System nicht abstuerzt, falls aus irgendeinem
Grund der Handler aktiviert wird, obwohl keiner definiert wurde...
*)
BEGIN
END emptyConvHandler;
(*---------------------------------------------------------------------------*)
PROCEDURE SkipBlanks ((* EIN/ -- *) str : ARRAY OF CHAR;
(* EIN/AUS *) VAR idx : INTEGER;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
(* Wenn <done> = TRUE ist, gibt <idx> den Index in <str> an,
an dem das erste Zeichen steht, das nicht Blank ist.
Ist <done> = FALSE, besteht der String nur aus Blanks,
oder es wurde ein Controlzeichen ( <= 20H, 7FH ) gefunden,
bevor ein druckendes Zeichen gefunden wurde; <idx> ist in
diesem Fall ohne Bedeutung, und 'lastResult' = invalidDigit,
sonst 'lastResult' = converted.
*)
BEGIN
WHILE ( idx <= HIGH( str )) & ( str[ idx ] = ' ' ) DO
INC( idx );
END;
nextIdx := idx;
IF ( idx <= HIGH( str )) & IsGraphic( str[ idx ]) THEN
done := TRUE;
lastResult := converted;
ELSE
done := FALSE;
lastResult := invalidDigit;
IF handlerOn THEN
Convhandler( aktProc, invalidDigit );
END;
END;
END SkipBlanks;
(*---------------------------------------------------------------------------*)
PROCEDURE FormStr ((* EIN/ -- *) feld,
(* EIN/ -- *) noetig : INTEGER;
(* -- /AUS *) VAR idx : INTEGER;
(* -- /AUS *) VAR str : ARRAY OF CHAR;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
(* Wenn in <str> mindestens fuer <noetig> Zeichen Platz ist, gilt
<done> = TRUE; in diesem Fall gibt <idx> die Position in <str>
an, ab der <noetig> Zeichen geschrieben werden koennen, sodass
sie rechtsbuendig im <feld> Zeichen langen <str> stehen; ist
<str> nicht gross genug, um <feld> Zeichen aufzunehmen, wird
<feld> entsprechend gekuerzt, der String ist aber mindestens
<noetig> Zeichen lang; er wird mit Leerzeichen bis <idx> gefuellt.
Die Zeichen ab <idx> sind undefiniert; der String ist in der be-
rechneten Laenge korrekt mit Nullbyte oder Feldende abgeschlossen,
sodass ab <idx> genau <noetig> Zeichen geschrieben werden muessen.
!! <noetig> muss groesser als Null sein !!
<done> = TRUE => 'lastChar' = converted, sonst strToShort.
*)
BEGIN
nextIdx := 0;
IF feld < noetig THEN
feld := noetig; (* mindestens <noetig> Zeichen *)
END;
DEC( feld ); DEC( noetig );
done := noetig <= HIGH( str );
IF ~done THEN
(* Der String reicht nicht fuer mindestens
* <noetig> Zeichen.
*)
str[ 0 ] := 0C; idx := 0;
lastResult := strToShort;
IF handlerOn THEN
Convhandler( aktProc, strToShort );
END;
RETURN;
END;
lastResult := converted;
IF HIGH( str ) <= feld THEN
(* Wenn der String nicht fuer <feld> Zeichen ausreicht,
* wird der String eben kuerzer; er ist dann mit dem
* Feldende abgeschlossen.
*)
idx := HIGH( str ) - noetig;
ELSE
(* sonst wird der String auf <feld> Zeichen
* gekuerzt. Da der String nicht mit dem Feld-
* ende abgeschlossen wird, muss noch ein
* Nullbyte hinter dem letzten benoetigten Zeichen
* angefuegt werden.
*)
idx := feld - noetig;
str[ feld + 1 ] := 0C;
END;
FOR noetig := 0 TO idx - 1 DO
(* String mit fuehrenden Leerzeichen auffuellen
* Der Rest ist egal, da er sowieso ueberschrieben
* wird.
*)
str[ noetig ] := ' ';
END;
END FormStr;
(*---------------------------------------------------------------------------*)
PROCEDURE DecToStr ((* EIN/ -- *) zahl : LONGCARD;
(* EIN/ -- *) feld : CARDINAL;
(* EIN/ -- *) signed : BOOLEAN;
(* -- /AUS *) VAR string : ARRAY OF CHAR;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
(* Das ist eine allgemeine Prozedur zur Umwandlung von Dezimal-
zahlen ( positiv und negativ ) in Strings. <zahl> ist der zu
wandelnde Wert; ob er als INTEGER bzw. LONGINT-Wert zu in-
terpretieren ist, wird ueber <signed> mitgeteilt.
Der gewandelte Wert steht rechtsbuendig im <feld> Zeichen
langen String <string>. Benoetigt die Zahlendarstellung
mehr Zeichen als in <feld> angegeben, wird <string> ent-
sprechend laenger. Passt die Zahlendarstellung nicht in
das durch <string> repraesentierte Feld, gilt
<done> = FALSE.
*)
VAR negativ : BOOLEAN;
vorz : CHAR;
i, idx : INTEGER;
str : ARRAY [0..11] OF CHAR;
BEGIN
IF signed THEN
IF VAL( LONGINT, zahl ) < 0D THEN
(* Wenn die Zahl negativ ist, Absolutwert
* nehmen und Vorzeichen separat merken.
*)
negativ := TRUE;
zahl := - VAL( LONGINT, zahl );
(* Falls <zahl> = MIN(LONGINT), veraendert sich
* die interne Zahlendarstellung nicht, da dieser
* Wert fuer eine Zahl mit Vorzeichen nicht als
* positiver Wert darstellbar ist ( unsymmetri-
* sche Zahlenbereiche bei Zweierkomplement );
* als LONGCARD interpretiert entspricht der
* kleinste negative Wert allerdings genau dem
* Wert nur mit positivem Vorzeichen.
*)
vorz := '-';
ELSE
vorz := ' ';
END; (* IF VAL(... *)
END; (* IF signed *)
i := 0;
(* Die Zahl von hinten nach vorne in String wandeln;
* durch die REPEAT-Schleife wird auch die Null
* dargestellt.
*)
REPEAT
str[ i ] := CardToDigit( zahl MOD 10D );
zahl := zahl DIV 10D;
INC( i );
UNTIL zahl = 0D;
IF signed THEN
str[ i ] := vorz;
INC( i );
END; (* IF signed *)
FormStr( feld, i, idx, string, done );
IF done THEN
(* Jetzt wird die Zahlendarstellung in umgekehrter
* Reihenfolge aus dem Hilfsstring in den eigentlichen
* String uebertragen.
*)
DEC( i );
WHILE i >= 0 DO
string[ idx ] := str[ i ];
INC( idx );
DEC( i );
END; (* WHILE *)
END; (* IF done *);
END DecToStr;
(*---------------------------------------------------------------------------*)
PROCEDURE StrToDec ((* EIN/ -- *) VAR string : ARRAY OF CHAR;
(* EIN/ -- *) max : LONGCARD;
(* EIN/ -- *) signed : BOOLEAN;
(* -- /AUS *) VAR wert : LONGCARD;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
(* Allgemeine Prozedur zur Wandlung von Strings in Dezimalzahlen
( positiv und negativ ). <max> ist der groesste darstellbare
POSITIVE Wert fuer <wert>. Ist <signed> = TRUE, werden auch
negative Zahldarstellungen ( mit fuerendem '-' ) akzeptiert,
die kleinste darstellbare NEGATIVE Zahl ist dann -(max + 1).
durch Interpretation von <wert> als negativer Zahl, werden
auch negative Werte korrekt zurueckgeliefert.
*)
VAR Index,
count : INTEGER;
minus : BOOLEAN;
vorz,
digit : CHAR;
maxZehntel,
ziffer : LONGCARD;
BEGIN
Index := 0;
wert := 0;
SkipBlanks( string, Index, done );
IF ~done THEN RETURN END;
vorz := string[ Index ];
minus := vorz = '-';
(* Ein evtl. vorhandenes Vorzeichen wird gemerkt
* und ueberlesen.
*)
IF vorz = '+' THEN
(* Ein positives Vorzeichen ist immer erlaubt.
*)
INC( Index );
ELSIF signed & minus THEN
(* Ein negatives Vorzeichen ist nur erlaubt,
* wenn <wert> auch negative Werte annehmen kann.
* Negative Zahlen haben einen um eins groesseren
* Wertebereich als positive Zahlen ( die Null
* ausgenommen ).
*)
INC( Index );
INC( max );
END;
maxZehntel := max DIV 10D;
count := Index;
LOOP
nextIdx := Index;
(* Abbrechen, sobald der String zuende ist, oder
* ein Zeichen gefunden wurde, das keine Dezimal-
* ziffer ist.
*)
IF Index > HIGH( string ) THEN EXIT; END;
digit := string[ Index ];
IF ~IsDigit( digit ) THEN EXIT; END;
ziffer := DigitToCard( digit );
(* Da <wert> mit jedem neuen Digit um eine Dezimalstelle
* erweitert wird, wird fuer die Ueberlaufpruefung der
* bisherige <wert> vor der Erweiterung mit einem Zehntel
* des Maximalwertes verglichen; wuerde nach der Erweiterung
* verglichen, waere der Ueberlauf ja womoeglich schon passiert,
* und dabei koennte auch ein LONGCARD-Ueberlauf auftreten -
* ein Vergleich wuerde dann nur Unsinn produzieren.
* Ist der bisherige Wert kleiner als ein Zehntel des
* Maximums, kann kein Ueberlauf auftreten, ist der bisherige
* Wert gleich dem Maximumszehntel, muss geprueft werden, ob
* das neue Digit den Wert des letzten Digits des Maximums
* ueberschreitet.
*)
IF ( wert < maxZehntel ) OR ( wert = maxZehntel )
& ( ziffer <= ( max MOD 10D ))
THEN
wert := wert * 10D + ziffer;
ELSE (* Ueberlauf *)
done := FALSE;
lastResult := overflow;
wert := 0D;
IF handlerOn THEN
Convhandler( aktProc, overflow );
END;
RETURN;
END;
INC( Index );
END; (* LOOP *)
(* Die Wandlung war nur ok, wenn mindestens eine Ziffer
* angegeben wurde, und der String hinter der letzten Ziffer
* zuende ist oder mindestens ein Begrenzungszeichen folgt.
*)
count := Index - count;
done := ( count >= 1 ) & ( ( Index > HIGH( string ))
OR IsDelimiter( digit ) );
IF ~done THEN
lastResult := invalidDigit;
IF handlerOn THEN
Convhandler( aktProc, invalidDigit );
END;
ELSE
IF signed & minus THEN
(* Wenn vor der Zahl ein '-' stand und negative
* Zahlen erlaubt sind, den bisher positiven
* Zahlenwert in einen negative wandeln.
*)
wert := - VAL( LONGINT, wert );
END;
END;
END StrToDec;
(*---------------------------------------------------------------------------*)
PROCEDURE BinToStr ((* EIN/ -- *) zahl : LONGCARD;
(* EIN/ -- *) feld : CARDINAL;
(* EIN/ -- *) basis : Base;
(* -- /AUS *) VAR string : ARRAY OF CHAR;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
(* Allgemeine Prozedur zur Wandlung positiver Zahlen
in Strings. Mit <basis> kann eine von vier Zahlenbasen
angegeben werden. Fuer die restlichen Parameter gilt
das unter "DecToStr" Gesagte.
*)
VAR MODmask : BITSET;
DIVshift : INTEGER;
str : ARRAY [0..32] OF CHAR;
i, idx : INTEGER;
BEGIN
(* Die zur Wandlung benoetigten MOD- und DIV-
* Operationen koennen bei einer Zahlendarstellung
* durch Zweierpotenzen mit AND-( ueber den
* Umweg BITSET )und SHIFT-Operationen schneller
* erledigt werden.
*)
IF basis = dec THEN
(* Wandlung von Dezimalzahlen erfolgt
* nicht hier ( laesst sich nicht durch
* Binaeoperationen erledigen ).
*)
DecToStr( zahl, feld, FALSE, string, done);
RETURN;
ELSIF basis = hex THEN
MODmask := BITSET{ 0..3 };
DIVshift := -4;
ELSIF basis = bin THEN
MODmask := BITSET{ 0 };
DIVshift := -1;
ELSE (* basis = oct *)
MODmask := BITSET{ 0..2 };
DIVshift := -3;
END;
i := 0;
(* Die Zahl von hinten nach vorne in String wandeln;
* durch die REPEAT-Schleife wird auch die Null
* dargestellt.
*)
REPEAT
str[ i ] := CardToHexDigit( VAL(CARDINAL,VAL(BITSET, zahl) * MODmask ));
zahl := SHIFT( zahl, DIVshift );
INC( i );
UNTIL zahl = 0D;
FormStr( feld, i, idx, string, done );
IF done THEN
(* Jetzt wird die Zahlendarstellung in umgekehrter
* Reihenfolge aus dem Hilfsstring in den eigentlichen
* String uebertragen.
*)
DEC( i );
WHILE i >= 0 DO
string[ idx ] := str[ i ];
INC( idx );
DEC( i );
END; (* WHILE *)
END; (* IF done *);
END BinToStr;
(*---------------------------------------------------------------------------*)
PROCEDURE StrToBin ((* EIN/ -- *) VAR string : ARRAY OF CHAR;
(* EIN/ -- *) max : LONGCARD;
(* EIN/ -- *) basis : Base;
(* -- /AUS *) VAR wert : LONGCARD;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
(* Wie "StrToDec", nur wird statt der konstanten Basis Zehn
eine angebbare benutzt.
*)
VAR Index,
count : INTEGER;
minus : BOOLEAN;
vorz,
digit : CHAR;
maxZehntel,
ziffer : LONGCARD;
gueltig : CharClassTest;
MODmask : BITSET;
DIVshift: INTEGER;
BEGIN
IF basis = dec THEN
(* Wandlung von Dezimalzahlen erfolgt
* nicht hier ( laesst sich nicht durch
* Binaeoperationen erledigen ).
*)
StrToDec( string, max, FALSE, wert, done );
RETURN;
ELSIF basis = hex THEN
gueltig := IsHexDigit;
MODmask := BITSET{ 0..3 };
DIVshift := -4;
ELSIF basis = bin THEN
gueltig := IsBinDigit;
MODmask := BITSET{ 0 };
DIVshift := -1;
ELSE (* basis = oct *)
gueltig := IsOctDigit;
MODmask := BITSET{ 0..2 };
DIVshift := -3;
END;
wert := 0;
Index := 0;
SkipBlanks( string, Index, done );
IF ~done THEN RETURN END;
IF vorz = '+' THEN
(* Ein positives Vorzeichen ist immer erlaubt.
*)
INC( Index );
END;
maxZehntel := SHIFT( max, DIVshift );
count := Index;
LOOP
nextIdx := Index;
IF Index > HIGH( string ) THEN EXIT; END;
digit := string[ Index ];
IF ~gueltig( digit ) THEN EXIT; END;
ziffer := HexDigitToCard( digit );
IF ( wert < maxZehntel )
OR ( wert = maxZehntel )
& ( ziffer <= VAL( LONGCARD, VAL( BITSET, max ) * MODmask ))
THEN
wert := SHIFT( wert, -DIVshift ) + ziffer;
ELSE (* Ueberlauf *)
done := FALSE;
lastResult := overflow;
wert := 0D;
IF handlerOn THEN
Convhandler( aktProc, overflow );
END;
RETURN;
END;
INC( Index );
END; (* LOOP *)
count := Index - count;
done := ( count >= 1 ) & ( ( Index > HIGH( string ))
OR IsDelimiter( digit ) );
IF ~done THEN
lastResult := invalidDigit;
IF handlerOn THEN
Convhandler( aktProc, invalidDigit );
END;
END; (* IF done *)
END StrToBin;
(*===========================================================================*)
(*== EXPORT =================================================================*)
PROCEDURE AssignConvHandler ((* EIN/ -- *) handler : ConvHandler );
(*T*)
BEGIN
Convhandler := handler;
handlerOn := TRUE;
END AssignConvHandler;
(*---------------------------------------------------------------------------*)
PROCEDURE UnAssignConvHandler;
(*T*)
BEGIN
Convhandler := emptyConvHandler;
handlerOn := FALSE;
END UnAssignConvHandler;
(*---------------------------------------------------------------------------*)
PROCEDURE LastConvResult ( ): ConvertResult;
(*T*)
BEGIN
RETURN( lastResult );
END LastConvResult;
(*---------------------------------------------------------------------------*)
PROCEDURE NextIndex ( ): INTEGER;
(*T*)
BEGIN
RETURN( nextIdx );
END NextIndex;
(*---------------------------------------------------------------------------*)
PROCEDURE BoolToStr ((* EIN/ -- *) wert : BOOLEAN;
(* EIN/ -- *) feld : CARDINAL;
(* -- /AUS *) VAR str : ARRAY OF CHAR;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
VAR i : INTEGER;
BEGIN
aktProc := 'BoolToStr';
FormStr( feld, 5 - ORD( wert ), i, str, done );
IF done THEN
IF wert THEN
str[ i ] := 'T';
str[ i+1 ] := 'R';
str[ i+2 ] := 'U';
str[ i+3 ] := 'E';
ELSE
str[ i ] := 'F';
str[ i+1 ] := 'A';
str[ i+2 ] := 'L';
str[ i+3 ] := 'S';
str[ i+4 ] := 'E';
END; (* IF wert *)
END; (* IF done *)
END BoolToStr;
(*---------------------------------------------------------------------------*)
PROCEDURE StrToBool ((* EIN/ -- *) str : ARRAY OF CHAR;
(* -- /AUS *) VAR wert : BOOLEAN;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
VAR Index : INTEGER;
ch : CHAR;
noch : CARDINAL;
BEGIN
aktProc := 'StrToBool';
Index := 0;
SkipBlanks( str, Index, done );
IF ~done THEN RETURN END;
noch := HIGH( str ) - Index;
ch := CAP( str[ Index ] );
done := ( ch = 'F' ) OR ( ch = 'T' );
IF done THEN
(* Der boolsche Wert kann schon aus dem
* ersten Zeichen gewonnen werden
*)
wert := ch = 'T';
IF noch >= 1 THEN
(* String ist noch nicht zuende,
* moeglicherweise folgen noch Zeichen
*)
ch := CAP( str[ Index+1 ] );
IF ~IsDelimiter( ch ) THEN
(* Es schliesst sich tatsaechlich noch
* mindestens ein druckbares Zeichen an.
*)
IF wert THEN
(* Wenn das erste Zeichen ein 'T' war, muss
* noch Platz fuer mindestens drei Zeichen sein
* damit ein 'TRUE' gebildet werden kann;
* Folgt dahinter noch ein Zeichen, darf es nicht
* druckbar sein.
*)
done := ( noch >= 3 )
& ( ch = 'R' )
& ( CAP( str[ Index+2 ] ) = 'U' )
& ( CAP( str[ Index+3 ] ) = 'E' )
& ( ( noch = 3 )
OR IsDelimiter( str[ Index+4 ]) );
ELSE
(* Wenn das erste Zeichen ein 'F' war, muss
* noch Platz fuer mindestens vier Zeichen sein
* damit ein 'FALSE' gebildet werden kann;
* Folgt dahinter noch ein Zeichen, darf es nicht
* druckbar sein.
*)
done := ( noch >= 4 )
& ( ch = 'A' )
& ( CAP( str[ Index+2 ] ) = 'L' )
& ( CAP( str[ Index+3 ] ) = 'S' )
& ( CAP( str[ Index+4 ] ) = 'E' )
& ( ( noch = 4 )
OR IsDelimiter( str[ Index+5 ]) );
END; (* IF wert *)
(* Diese Art der Abfrage funktioniert nur, weil
* nach dem ersten ungueltigen Ausdruck der
* Wahrheitswert feststeht und die weiteren
* Ausdruecke nicht mehr ausgewertet werden.
*)
IF done THEN
INC( Index, 4 - ORD( wert ));
END;
END; (* IF ~IsDelimiter *)
END; (* IF noch *)
END; (* IF done *)
nextIdx := Index + 1; (* stimmt nicht ganz... *)
IF ~done THEN
lastResult := invalidDigit;
IF handlerOn THEN
Convhandler( aktProc, invalidDigit );
END;
END;
END StrToBool;
(*---------------------------------------------------------------------------*)
PROCEDURE BitsetToStr ((* EIN/ -- *) menge: BITSET;
(* EIN/ -- *) feld : CARDINAL;
(* -- /AUS *) VAR str : ARRAY OF CHAR;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
VAR Bit, idx : INTEGER;
BEGIN
aktProc := 'BitsetToStr';
FormStr( feld, 16, idx, str, done );
IF done THEN
FOR Bit := 15 TO 0 BY -1 DO
IF Bit IN menge THEN
str[ idx ] := '1';
ELSE
str[ idx ] := '0';
END;
INC( idx );
END; (* FOR *)
END; (* IF done *)
END BitsetToStr;
(*---------------------------------------------------------------------------*)
PROCEDURE StrToBitset ((* EIN/ -- *) str : ARRAY OF CHAR;
(* -- /AUS *) VAR menge: BITSET;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
VAR idx, Bit : INTEGER;
digit : CHAR;
BEGIN
aktProc := 'StrToBitset';
idx := 0;
SkipBlanks( str, idx, done );
IF ~done THEN RETURN END;
menge := BITSET{ }; (* dadurch nur Bits setzen, nicht loeschen *)
Bit := 15; (* mit dem hoechstwertigen Bit beginnen *)
LOOP
(* Abbrechen, wenn der String zuende ist, ein Zeichen auftritt,
* das keine Binaerziffer ist oder bereits 16 Bits ermittelt
* wurden.
*)
IF ( idx > HIGH( str )) OR ( Bit < 0 ) THEN EXIT; END;
digit := str[ idx ];
IF digit = '1' THEN
INCL( menge, Bit );
ELSIF digit # '0' THEN (* keine Binaerziffer *)
EXIT;
END;
INC( idx );
DEC( Bit );
END; (* LOOP *)
nextIdx := idx;
done := ( Bit = -1 ) & (( idx > HIGH( str )) OR IsDelimiter( str[ idx ]));
IF ~done THEN
lastResult := invalidDigit;
IF handlerOn THEN
Convhandler( aktProc, invalidDigit );
END;
END;
END StrToBitset;
(*---------------------------------------------------------------------------*)
PROCEDURE CardToStr ((* EIN/ -- *) wert : CARDINAL;
(* EIN/ -- *) feld : CARDINAL;
(* -- /AUS *) VAR str : ARRAY OF CHAR;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
BEGIN
aktProc := 'CardToStr';
DecToStr( wert, feld, FALSE, str, done);
END CardToStr;
(*---------------------------------------------------------------------------*)
PROCEDURE LongCardToStr ((* EIN/ -- *) wert : LONGCARD;
(* EIN/ -- *) feld : CARDINAL;
(* -- /AUS *) VAR str : ARRAY OF CHAR;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
BEGIN
aktProc := 'LongCardToStr';
DecToStr( wert, feld, FALSE, str, done);
END LongCardToStr;
(*---------------------------------------------------------------------------*)
PROCEDURE StrToCard ((* EIN/ -- *) str : ARRAY OF CHAR;
(* -- /AUS *) VAR wert : CARDINAL;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
VAR langwert : LONGCARD;
BEGIN
aktProc := 'StrToCard';
StrToDec( str, MAX(CARDINAL), FALSE, langwert, done );
(* Auf keinen Fall mit SHORT() zuweisen,
* da SHORT() einen INTEGER-Wert liefert,
* und beim Bereichstest deshalb schon Alarm
* geschlagen wird, wenn <langwert> groesser
* als MAX(INTEGER) ist !!!
*)
wert := langwert;
END StrToCard;
(*---------------------------------------------------------------------------*)
PROCEDURE StrToLongCard ((* EIN/ -- *) str : ARRAY OF CHAR;
(* -- /AUS *) VAR wert : LONGCARD;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
BEGIN
aktProc := 'StrToLongCard';
StrToDec( str, MAX(LONGCARD), FALSE, wert, done );
END StrToLongCard;
(*---------------------------------------------------------------------------*)
PROCEDURE IntToStr ((* EIN/ -- *) wert : INTEGER;
(* EIN/ -- *) feld : CARDINAL;
(* -- /AUS *) VAR str : ARRAY OF CHAR;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
BEGIN
aktProc := 'IntToStr';
DecToStr( LONG( wert ), feld, TRUE, str, done);
END IntToStr;
(*---------------------------------------------------------------------------*)
PROCEDURE LongIntToStr ((* EIN/ -- *) wert : LONGINT;
(* EIN/ -- *) feld : CARDINAL;
(* -- /AUS *) VAR str : ARRAY OF CHAR;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
BEGIN
aktProc := 'LongIntToStr';
DecToStr( wert, feld, TRUE, str, done);
END LongIntToStr;
(*---------------------------------------------------------------------------*)
PROCEDURE StrToInt ((* EIN/ -- *) str : ARRAY OF CHAR;
(* -- /AUS *) VAR wert : INTEGER;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
VAR langwert : LONGCARD;
BEGIN
aktProc := 'StrToInt';
StrToDec( str, MAX(INTEGER), TRUE, langwert, done );
wert := VAL( INTEGER, langwert );
END StrToInt;
(*---------------------------------------------------------------------------*)
PROCEDURE StrToLongInt ((* EIN/ -- *) str : ARRAY OF CHAR;
(* -- /AUS *) VAR wert : LONGINT;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
VAR langwert : LONGCARD;
BEGIN
aktProc := 'StrToLongInt';
StrToDec( str, MAX(LONGINT), TRUE, langwert, done );
wert := VAL( LONGINT, langwert);
END StrToLongInt;
(*---------------------------------------------------------------------------*)
PROCEDURE ShortNumToStr ((* EIN/ -- *) wert : BYTE;
(* EIN/ -- *) basis: Base;
(* EIN/ -- *) feld : CARDINAL;
(* -- /AUS *) VAR str : ARRAY OF CHAR;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
BEGIN
aktProc := 'ShortNumToStr';
BinToStr( VAL( LONGCARD, wert ), feld, basis, str, done);
END ShortNumToStr;
(*---------------------------------------------------------------------------*)
PROCEDURE NumToStr ((* EIN/ -- *) wert : WORD;
(* EIN/ -- *) basis: Base;
(* EIN/ -- *) feld : CARDINAL;
(* -- /AUS *) VAR str : ARRAY OF CHAR;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
BEGIN
aktProc := 'NumToStr';
BinToStr( VAL( LONGCARD, wert ), feld, basis, str, done);
END NumToStr;
(*---------------------------------------------------------------------------*)
PROCEDURE LongNumToStr ((* EIN/ -- *) wert : LONGCARD;
(* EIN/ -- *) basis: Base;
(* EIN/ -- *) feld : CARDINAL;
(* -- /AUS *) VAR str : ARRAY OF CHAR;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
BEGIN
aktProc := 'LongNumToStr';
BinToStr( wert, feld, basis, str, done);
END LongNumToStr;
(*---------------------------------------------------------------------------*)
PROCEDURE StrToShortNum ((* EIN/ -- *) str : ARRAY OF CHAR;
(* EIN/ -- *) basis: Base;
(* -- /AUS *) VAR wert : BYTE;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
VAR langwert : LONGCARD;
BEGIN
aktProc := 'StrToShortNum';
StrToBin( str, 255D, basis, langwert, done );
wert := VAL( CHAR, langwert );
END StrToShortNum;
(*---------------------------------------------------------------------------*)
PROCEDURE StrToNum ((* EIN/ -- *) str : ARRAY OF CHAR;
(* EIN/ -- *) basis: Base;
(* -- /AUS *) VAR wert : WORD;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
VAR langwert : LONGCARD;
BEGIN
aktProc := 'StrToNum';
StrToBin( str, MAX(CARDINAL), basis, langwert, done );
wert := VAL( CARDINAL, langwert );
END StrToNum;
(*---------------------------------------------------------------------------*)
PROCEDURE StrToLongNum ((* EIN/ -- *) str : ARRAY OF CHAR;
(* EIN/ -- *) basis: Base;
(* -- /AUS *) VAR wert : LONGCARD;
(* -- /AUS *) VAR done : BOOLEAN );
(*T*)
BEGIN
aktProc := 'StrToLongNum';
StrToBin( str, MAX(LONGCARD), basis, wert, done );
END StrToLongNum;
(*===========================================================================*)
BEGIN (* ConvertStr *)
Convhandler := emptyConvHandler;
handlerOn := FALSE;
END ConvertStr.