home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
549a.lha
/
M2P_v1.0
/
mods.lzh
/
Strings.mod
< prev
next >
Wrap
Text File
|
1991-08-10
|
13KB
|
468 lines
(*======================================================================*)
(* Standard Modula-2 Libraries -- Strings *)
(*======================================================================*)
(* Version: 0.00 Author: Dennis Brueni *)
(* Date: 06-21-91 Changes: original *)
(*======================================================================*)
(* Refs: --Portable Modula-2 Programming -- Woodman, Griffith, *)
(* Souter, and Davies *)
(* --Interim Version of 4th Working Draft Modula-2 Standard *)
(*======================================================================*)
(* Notes: (implementation specific) *)
(* *)
(* This is the portable version which is coded in Modula-2 rather than *)
(* assembly. The only implementation dependent feature used is the *)
(* choice of StrTerm (StringTerminator) as ASCII.NUL. *)
(*======================================================================*)
IMPLEMENTATION MODULE Strings;
IMPORT
ASCII;
(*----------------------------------------------------------------------*)
CONST
StrTerm = ASCII.NUL;
(* I trust this code, although it relies on *)
(* boolean expression short circuiting *)
(*----------------------------------------------------------------------*)
PROCEDURE Length(StringVal: ARRAY OF CHAR) : CARDINAL;
VAR
i: CARDINAL;
BEGIN
i:=0;
WHILE (i<=HIGH(StringVal)) AND (StringVal[i] # StrTerm) DO
INC(i);
END;
(* Postcondition: *)
RETURN(i); (* i=HIGH+1 OR S[i]=NUL *)
END Length;
(*----------------------------------------------------------------------*)
PROCEDURE Assign(Source: ARRAY OF CHAR; VAR Destination: ARRAY OF CHAR);
VAR
len,siz,i: CARDINAL;
BEGIN
siz:=HIGH(Destination)+1; (* Capacity of Destination *)
len:=Length(Source); (* Length of Source *)
IF len >= siz THEN
len:=siz; (* Truncate of too big *)
ELSE
Destination[len]:=StrTerm;
(* Else insert Terminator *)
END;
i:=len;
WHILE (i#0) DO
DEC(i);
Destination[i]:=Source[i];
END;
END Assign;
(*----------------------------------------------------------------------*)
PROCEDURE Extract(Source: ARRAY OF CHAR; StartIndex, NumberToExtract:CARDINAL; VAR Destination:ARRAY OF CHAR);
VAR
len,i: CARDINAL;
BEGIN
IF NumberToExtract > HIGH(Destination) THEN
(* Truncate if size is *)
NumberToExtract:=HIGH(Destination)+1;
(* too big to fit. *)
END;
len:=Length(Source);
IF StartIndex > len THEN (* Invalid Start Index *)
NumberToExtract:=0;
ELSIF NumberToExtract+StartIndex >= len THEN
(* If trying to extract *)
NumberToExtract:=len-StartIndex;
(* more than there is *)
END;
i:=0;
WHILE (i<NumberToExtract) DO
Destination[i]:=Source[StartIndex+i];
INC(i);
END;
IF HIGH(Destination) >= NumberToExtract THEN
(* If There's room, *)
Destination[NumberToExtract]:=StrTerm;
(* append terminator *)
END;
END Extract;
(*----------------------------------------------------------------------*)
PROCEDURE Delete(VAR StringValue: ARRAY OF CHAR; StartIndex, NumberToDelete: CARDINAL);
VAR
len,i: CARDINAL;
BEGIN
len:=Length(StringValue);
IF StartIndex <= len THEN (* Invalid Start Index *)
IF NumberToDelete > 0 THEN
(* Anything TO DO? *)
IF NumberToDelete+StartIndex>=len THEN
(* Deleting past end is *)
StringValue[StartIndex]:=StrTerm;
(* same as truncating. *)
ELSE
i:=StartIndex;
WHILE (i<len-NumberToDelete) DO
StringValue[i]:=StringValue[NumberToDelete+i];
INC(i);
END;
StringValue[len-NumberToDelete]:=StrTerm;
END;
END;
END;
END Delete;
(*----------------------------------------------------------------------*)
PROCEDURE Insert(Source: ARRAY OF CHAR; StartIndex: CARDINAL; VAR Destination: ARRAY OF CHAR);
VAR
DestLen,SourceLen,DestSize,i: CARDINAL;
BEGIN
DestLen :=Length(Destination);
DestSize :=HIGH(Destination)+1;
SourceLen:=Length(Source);
IF StartIndex <= DestLen THEN (* Legal Start Index *)
IF SourceLen + DestLen >= DestSize THEN
(* Doesn't fit in Dest. *)
IF SourceLen + StartIndex >= DestSize THEN
(* Too long *)
SourceLen := DestSize - StartIndex;
(* Truncate Source *)
DestLen := StartIndex;
(* Truncate Destination *)
ELSE
DestLen := DestSize-SourceLen;
(* Just Truncate Dest. *)
END;
ELSE
Destination[SourceLen+DestLen]:=StrTerm;
(* Plug in Terminator *)
END;
i:=DestLen;
WHILE (i>StartIndex) DO
DEC(i);
Destination[SourceLen+i]:=Destination[i];
END;
i:=SourceLen;
WHILE (i>0) DO
DEC(i);
Destination[StartIndex+i]:=Source[i];
END;
END;
END Insert;
(*----------------------------------------------------------------------*)
PROCEDURE Replace(Source: ARRAY OF CHAR; StartIndex: CARDINAL; VAR Destination: ARRAY OF CHAR);
VAR
DestLen,SourceLen,i: CARDINAL;
BEGIN
DestLen :=Length(Destination);
SourceLen:=Length(Source);
IF StartIndex < DestLen THEN (* If legal Start Index *)
IF SourceLen + StartIndex > DestLen THEN
(* Truncate Source if *)
SourceLen := DestLen - StartIndex;
(* too big. *)
END;
i:=SourceLen;
WHILE (i>0) DO
DEC(i);
Destination[StartIndex+i]:=Source[i];
END;
END;
END Replace;
(*----------------------------------------------------------------------*)
PROCEDURE Append(Source: ARRAY OF CHAR; VAR Destination: ARRAY OF CHAR);
VAR
SourceLen,DestLen,i: CARDINAL;
BEGIN
DestLen:=Length(Destination);
SourceLen:=Length(Source);
IF DestLen+SourceLen > HIGH(Destination) THEN
SourceLen:=HIGH(Destination)+1-DestLen;
ELSE
Destination[DestLen+SourceLen]:=StrTerm;
END;
i:=SourceLen;
WHILE (i#0) DO
DEC(i);
Destination[DestLen+i]:=Source[i];
END;
END Append;
(*----------------------------------------------------------------------*)
(* The optimization of not copying the pass-by-value strings on the *)
(* stack (@NoCopyStrings) cannot be used here since an undesirable *)
(* side-effect will result if Source2 and Destination are the same. *)
(*----------------------------------------------------------------------*)
PROCEDURE Concat(Source1, Source2: ARRAY OF CHAR; VAR Destination: ARRAY OF CHAR);
BEGIN
Assign(Source1,Destination);
Append(Source2,Destination);
END Concat;
(*----------------------------------------------------------------------*)
(* NOTE: This should really use CharClass.IsLower, CharClass.ToUpper *)
(*----------------------------------------------------------------------*)
PROCEDURE Capitalize(VAR StringVar: ARRAY OF CHAR);
VAR
i,len: CARDINAL;
BEGIN
len:=Length(StringVar);
i:=0;
WHILE i<len DO
IF (StringVar[i]>='a') AND (StringVar[i]<='z') THEN
StringVar[i]:=CHR(ORD(StringVar[i])-ORD('a')+ORD('A'));
END;
INC(i);
END;
END Capitalize;
(*----------------------------------------------------------------------*)
(* Compare two string values according to the implementation-defined *)
(* collating sequence. This is the local version to this module which *)
(* is shared by Equal, Compare, and FindDiff. *)
(*----------------------------------------------------------------------*)
PROCEDURE Comp(VAR String1,String2: ARRAY OF CHAR; VAR i: CARDINAL):CompareResult;
VAR
len1,len2,minlen: CARDINAL;
BEGIN
len1:=Length(String1);
len2:=Length(String2);
minlen:=len2;
IF minlen>len1 THEN
minlen:=len1;
END;
i:=0;
WHILE i<minlen DO
IF String1[i] > String2[i] THEN
RETURN greater;
END;
IF String1[i] < String2[i] THEN
RETURN less;
END;
INC(i);
END;
IF len2=len1 THEN
RETURN equal;
END;
IF len2>len1 THEN
RETURN less; (* The longer one is *)
ELSE
RETURN greater;
END; (* considered the high *)
END Comp;
(*----------------------------------------------------------------------*)
PROCEDURE Compare(StringVal1: ARRAY OF CHAR; StringVal2: ARRAY OF CHAR): CompareResult;
VAR
dummy: CARDINAL;
BEGIN
RETURN Comp(StringVal1,StringVal2,dummy);
END Compare;
(*----------------------------------------------------------------------*)
PROCEDURE Equal(StringVal1: ARRAY OF CHAR; StringVal2: ARRAY OF CHAR): BOOLEAN;
VAR
dummy: CARDINAL;
BEGIN
RETURN Comp(StringVal1,StringVal2,dummy)=equal;
END Equal;
(*----------------------------------------------------------------------*)
PROCEDURE FindDiff(StringVal1: ARRAY OF CHAR; StringVal2: ARRAY OF CHAR; VAR DifferenceFound: BOOLEAN; VAR PosOfDifference:
CARDINAL);
VAR
dummy: CARDINAL;
BEGIN
DifferenceFound:=Comp(StringVal1,StringVal2,dummy)#equal;
IF DifferenceFound THEN
PosOfDifference:=dummy;
END;
END FindDiff;
(*----------------------------------------------------------------------*)
PROCEDURE FindNext(Pattern: ARRAY OF CHAR; StringValue: ARRAY OF CHAR; StartIndex: CARDINAL; VAR PatternFound: BOOLEAN; VAR
PosOfPattern: CARDINAL);
VAR
i,patlen,len,pos: CARDINAL;
BEGIN
len:=Length(StringValue);
patlen:=Length(Pattern);
IF patlen<=len THEN
IF len-patlen>=StartIndex THEN
pos:=StartIndex;
WHILE pos<=len-patlen DO
(* While still within String *)
i:=0;
LOOP
IF i>=patlen THEN
(* If matched entire Pattern *)
PatternFound:=TRUE;
PosOfPattern:=pos;
RETURN;
END;
IF (i+pos>=len) OR (StringValue[i+pos] <> Pattern[i]) THEN
EXIT;
END;
INC(i);
END;
INC(pos);
(* No Match, Next... *)
END;
END;
END;
PatternFound:=FALSE;
END FindNext;
(*----------------------------------------------------------------------*)
PROCEDURE FindPrev(Pattern: ARRAY OF CHAR; StringValue: ARRAY OF CHAR; StartIndex: CARDINAL; VAR PatternFound: BOOLEAN; VAR
PosOfPattern: CARDINAL);
VAR
i,patlen,len,pos: CARDINAL;
BEGIN
len:=Length(StringValue);
patlen:=Length(Pattern);
IF (patlen<=len) AND (StartIndex>=patlen) THEN
IF StartIndex>len-patlen THEN
StartIndex:=len;
END;
pos:=StartIndex-patlen+1;
WHILE pos>0 DO (* While still within String *)
DEC(pos); (* No Match, Next... *)
i:=0;
LOOP
IF i>=patlen THEN
(* If matched entire Pattern *)
PatternFound:=TRUE;
PosOfPattern:=pos;
RETURN;
END;
IF (i+pos>=len) OR (StringValue[i+pos] <> Pattern[i]) THEN
EXIT;
END;
INC(i);
END;
END;
END;
PatternFound:=FALSE;
END FindPrev;
(*----------------------------------------------------------------------*)
PROCEDURE CanAssignAll(SourceLength: CARDINAL; VAR Destination: ARRAY OF CHAR): BOOLEAN;
BEGIN
RETURN HIGH(Destination)+1 >= SourceLength;
END CanAssignAll;
(*----------------------------------------------------------------------*)
PROCEDURE CanExtractAll(SourceLength, StartIndex, NumberToExtract: CARDINAL; VAR Destination: ARRAY OF CHAR): BOOLEAN;
BEGIN
RETURN (StartIndex + NumberToExtract <= SourceLength) AND (HIGH(Destination)+1 >= NumberToExtract);
END CanExtractAll;
(*----------------------------------------------------------------------*)
PROCEDURE CanDeleteAll(StringLength, StartIndex, NumberToDelete: CARDINAL): BOOLEAN;
BEGIN
RETURN (StartIndex < StringLength) AND (StringLength+1 > StartIndex + NumberToDelete );
END CanDeleteAll;
(*----------------------------------------------------------------------*)
PROCEDURE CanInsertAll(SourceLength, StartIndex: CARDINAL; VAR Destination: ARRAY OF CHAR): BOOLEAN;
VAR
LDest: CARDINAL;
BEGIN
LDest:=Length(Destination);
RETURN (StartIndex <= LDest) AND (LDest+SourceLength <= HIGH(Destination)+1);
END CanInsertAll;
(*----------------------------------------------------------------------*)
PROCEDURE CanReplaceAll(SourceLength, StartIndex: CARDINAL; VAR Destination: ARRAY OF CHAR): BOOLEAN;
BEGIN
RETURN SourceLength + StartIndex <= Length (Destination);
END CanReplaceAll;
(*----------------------------------------------------------------------*)
PROCEDURE CanAppendAll(SourceLength: CARDINAL; VAR Destination: ARRAY OF CHAR): BOOLEAN;
BEGIN
RETURN Length(Destination) + SourceLength <= HIGH(Destination)+1;
END CanAppendAll;
(*----------------------------------------------------------------------*)
PROCEDURE CanConcatAll(Source1Length, Source2Length: CARDINAL; VAR Destination: ARRAY OF CHAR): BOOLEAN;
BEGIN
RETURN Source1Length + Source2Length <= HIGH(Destination)+1;
END CanConcatAll;
END Strings.