(******************************************************************************
*                                                                             *
*    Programmname:  StringSupport                                             *
*                                                                             *
*    Stand:         05.11.89                            Uhrzeit:  20:15:18    *
*                                                                             *
*    Bearbeitet mit dem MODULETool V1.1         (©) by  Thomas Stolze 1989    *
*                                                                             *
******************************************************************************)

(* $R- *) (* $V- *) (* $S- *) (* $N- *) (* $F- *)
IMPLEMENTATION MODULE StringSupport;

FROM Str IMPORT CapString,Compare,Concat,Copy,FirstPos,Length;

PROCEDURE MidStr(VAR string : ARRAY OF CHAR; oldstring : ARRAY OF CHAR;
                 from,length : INTEGER);
VAR len,i,j  :  INTEGER;
    merkstr  :  ARRAY [0..80] OF CHAR;
BEGIN
  Copy(merkstr,oldstring);
  j:=0;
  FOR i:=from-1 TO (from+length)-2 DO
      oldstring[j]:=merkstr[i];
      INC(j);
  END;
  oldstring[j]:=00C; Copy(string,oldstring);   
END MidStr;

PROCEDURE RightStr(VAR string : ARRAY OF CHAR; oldstring : ARRAY OF CHAR;
                   from : INTEGER);
VAR i,j,k    : INTEGER;
BEGIN
   k:=0; i:=Length(oldstring);
   FOR j:=from-1 TO i DO
       oldstring[k]:=oldstring[j];
       INC(k);
   END;
   oldstring[k]:=00C; Copy(string,oldstring);    
END RightStr;

PROCEDURE LeftStr(VAR string : ARRAY OF CHAR; oldstring : ARRAY OF CHAR;
                  cutafter : INTEGER);
BEGIN
  oldstring[cutafter]:=00C; Copy(string,oldstring);
END LeftStr;

PROCEDURE RotateStr(VAR string : ARRAY OF CHAR; n : INTEGER);
VAR i,j,len : INTEGER;
    char    : CHAR;
BEGIN
  len:=Length(string)-1;
  IF (n >= 0) THEN
     FOR i:=1 TO n DO  
         char:=string[len];
         FOR j:=0 TO len-1 DO
             string[len-j]:=string[len-j-1];
         END;
         string[0]:=char;
     END;    
  ELSE
    FOR i:=-1 TO n  BY -1 DO
        char:=string[0];
        FOR j:=0 TO len-1 DO
            string[j]:=string[j+1];
        END;
        string[len-1]:=char;
    END;
  END;                     
END RotateStr;

PROCEDURE ProduceStr(VAR string : ARRAY OF CHAR; char : CHAR; length : INTEGER);
VAR i  : INTEGER;
BEGIN;
   FOR i:=0 TO length-1 DO
     string[i]:=char;
   END;
   string[i]:=00C;   
END ProduceStr;

PROCEDURE StringStr(VAR str : ARRAY OF CHAR; x : LONGINT; n : INTEGER);
VAR print: ARRAY [0..40] OF CHAR;
    rest,
     i,j : INTEGER;
  negativ: BOOLEAN;   
BEGIN
  IF (x < 0) THEN
     x:=ABS(x); negativ:=TRUE; i:=0;
  ELSE
     i:=0; negativ:=FALSE;
  END; 
  IF (x > 0) THEN
     WHILE (x > 0) DO
       rest:=x MOD 10;
       x:=x DIV 10;
       str[i]:=CHR(rest+48);
       i:=i+1;
     END;
       str[i]:=00C; j:=Length(str);
     IF ((n <= 0) OR (n < j)) THEN
        n:=j
     END;   
     FOR i:=0 TO n-1 DO 
       IF i < n-j THEN
         print[i]:=CHR(32);
       ELSE  
         print[i]:=str[n-i-1];
       END;  
     END;
       print[n]:=00C; i:=0;
     IF (negativ = TRUE) THEN
        IF (n-j-1 >= 0) THEN
            print[n-j-1]:="-";
        END;
     END;
     Copy(str,print);
  ELSE 
    ProduceStr(str," ",n); str[n-1]:=CHR(48);
  END;
END StringStr;

PROCEDURE ValStr(numString : ARRAY OF CHAR): LONGINT;
VAR len,i,k,
    num       : INTEGER;
    negativ   : BOOLEAN;
    n,j       : LONGINT;
BEGIN
  len:=Length(numString);
  IF len <= 0 THEN RETURN 0 END;
  
  i:=0; n:=0; j:=0; negativ:=FALSE;
  REPEAT
    num:=ORD(numString[len-i-1])-48; 
    IF (num >= 0) AND (num <= 9) THEN
       j:=1;
       FOR k:=0 TO i-1 DO
           j:=j*10;
       END;
       n:=n + (num * j);
    ELSIF numString[len-i-1] = "-" THEN
       negativ := TRUE;   
    END;
    INC(i);
  UNTIL len-i = 0;
  IF negativ THEN RETURN - n END;
  RETURN n;
END ValStr;

PROCEDURE DeleteStr(VAR str : ARRAY OF CHAR; from,length : INTEGER);
VAR  merk : ARRAY [0..80] OF CHAR;
     i,j  : INTEGER;
BEGIN
  i:=Length(str); Copy(merk,str);
  IF ((from+length) >= i) THEN
     str[from]:=00C;
  ELSE
     IF (from < 1) THEN
        from:=1;
     END;   
     RightStr(merk,merk,from+length);
       str[from-1]:=00C;
     Concat(str,merk);
  END;   
END DeleteStr;

PROCEDURE InsertStr(VAR string : ARRAY OF CHAR; token : ARRAY OF CHAR; 
                    at : INTEGER);
VAR merk,merk2 : ARRAY [0..80] OF CHAR;
BEGIN
  Copy(merk,string); at:=at-1;
    LeftStr(merk,string,at);     Concat(merk,token);
    RightStr(merk2,string,at+1); Concat(merk,merk2);
  Copy(string,merk);
END InsertStr;

PROCEDURE ChangeStr(VAR str1,str2 : ARRAY OF CHAR);
VAR   merk : ARRAY [0..80] OF CHAR;
BEGIN
  Copy(merk,str1); Copy(str1,str2); Copy(str2,merk);  
END ChangeStr;

PROCEDURE Occurs(str : ARRAY OF CHAR; from : INTEGER;
                       token : ARRAY OF CHAR; caseSense : BOOLEAN): INTEGER;
VAR pos,altpos,i,
    firstpos,
    tokLen,
    strLen : INTEGER;
    gleich : BOOLEAN;
BEGIN
  IF (NOT caseSense) THEN
     CapString(str); CapString(token);
  END;   
  tokLen:=Length(token); strLen:=Length(str); gleich:=FALSE; i:=1;
  pos:=FirstPos(str,from,token[i-1]);
  WHILE ((pos # -1) AND (from <= strLen)) DO
      gleich:=TRUE; altpos:=pos; firstpos:=pos;
      WHILE ((i # tokLen) AND (gleich)) DO
        pos:=FirstPos(str,altpos+1,token[i]);
        IF (pos-1 = altpos) THEN
           altpos:=pos;
        ELSE
           gleich:=FALSE;
        END;
        INC(i);
      END;
      IF gleich THEN 
         RETURN firstpos;
      ELSE
         i:=1; INC(from); pos:=FirstPos(str,from,token[i-1]);
      END;   
  END;
  RETURN pos;             
END Occurs;
                         
PROCEDURE LGT( str1,str2 : ARRAY OF CHAR): BOOLEAN;
VAR  pos : INTEGER;
BEGIN
  pos:=Compare(str1,str2);
  IF (pos < 0) THEN
     RETURN TRUE
  END;
  RETURN FALSE;        
END LGT;

PROCEDURE LGE( str1,str2 : ARRAY OF CHAR): BOOLEAN;
VAR  pos : INTEGER;
BEGIN
  pos:=Compare(str1,str2);
  IF (pos <= 0) THEN
     RETURN TRUE
  END;
  RETURN FALSE;        
END LGE;

PROCEDURE LLE( str1,str2 : ARRAY OF CHAR): BOOLEAN;
VAR  pos : INTEGER;
BEGIN
  pos:=Compare(str1,str2);
  IF (pos >= 0) THEN
     RETURN TRUE
  END;
  RETURN FALSE;        
END LLE;

PROCEDURE LLT( str1,str2 : ARRAY OF CHAR): BOOLEAN;
VAR  pos : INTEGER;
BEGIN
  pos:=Compare(str1,str2);
  IF (pos > 0) THEN
     RETURN TRUE
  END;
  RETURN FALSE;        
END LLT;

PROCEDURE LEQ( str1,str2 : ARRAY OF CHAR): BOOLEAN;
VAR  pos : INTEGER;
BEGIN
  pos:=Compare(str1,str2);
  IF (pos = 0) THEN
     RETURN TRUE
  END;
  RETURN FALSE;        
END LEQ;

BEGIN
END StringSupport.