(*---------------------------------------------------------------------------
  :Program.    BoyerMoore.mod
  :Author.     Thomas Igracki
  :Address.    Obstallee 45, D-13593 Berlin
  :E-Mail.     UseNet -> lokai@cs.tu-berlin.de
  :E-Mail.     Z-Netz -> T.Igracki@BAMP.ZER
  :E-Mail.     Fido   -> Thomas_Igracki%2:2403_10.40
  :Version.    1.0
  :Date.       22.02.93
  :Copyright.  Thomas Igracki (If you like to use it, contact me!)
  :Language.   Oberon-2
  :Translator. Amiga Oberon V3.00d
  :Contents.   Ein Modul das den BoyerMoore Suchalgorithmus implementiert.
  :Usage.      IMPORT BoyerMoore;
  :Remark.     Aus KickStart 7/8 1992 S.79 von Pascal nach Oberon umgesetz
---------------------------------------------------------------------------*)

MODULE BoyerMoore;
IMPORT
   st: Strings;

PROCEDURE SetUpDelta1 (VAR Delta1: ARRAY OF INTEGER; M: INTEGER; p: ARRAY OF CHAR); (* $CopyArrays- *)
VAR i: INTEGER;
BEGIN
     i := 0; REPEAT Delta1[i] := M; INC(i) UNTIL i = 256;
     i := 0; REPEAT Delta1[ORD(p[i])] := M-i-1; INC(i) UNTIL i >= M-1;
END SetUpDelta1;

PROCEDURE SearchPos* (s,p: ARRAY OF CHAR; start, len: LONGINT): LONGINT; (* $CopyArrays- *)
VAR
  i,j,M,N: LONGINT; Delta1: ARRAY 256 OF INTEGER;
BEGIN
     M := st.Length(p)+start;
     IF len > 0 THEN N := len ELSE N := st.Length(s) END;
     IF (N > 0) & (M > 0) & (N >= M) & (start >= 0) THEN
        SetUpDelta1 (Delta1, SHORT(M),p);
        (* Muster links an den Text anlegen und dann im Muster selbst von *)
        (* rechts nach links vergleichen *)
        i := M-1; j := i;

        REPEAT
           IF p[j] = s[i] THEN (* OK *) DEC(i); DEC(j)
           ELSE (* MisMatch *)
              IF M-j > Delta1[ORD(s[i])] THEN INC(i,M-j+Delta1[ORD(s[i])])
                                         ELSE INC(i,Delta1[ORD(s[i])])
              END;
              j := M-1;
           END;
        UNTIL (j < 0) OR (i >= N);
        IF j < 0 THEN RETURN i+1 ELSE RETURN -1 END;
     ELSE
        RETURN -1
     END;
END SearchPos;

(* SearchPosNoCase(), ohne Groß/KleinUnterscheidung *)
PROCEDURE SearchPosNC* (s,p: ARRAY OF CHAR; start, len: LONGINT): LONGINT; (* $CopyArrays- *)
BEGIN     st.Upper(s); st.Upper(p); RETURN SearchPos (s,p, start,len);
END SearchPosNC;

(* Suche beginnt immer bei 0 *)
PROCEDURE Search*(s,p: ARRAY OF CHAR; len: LONGINT): LONGINT; (* $CopyArrays- *)
BEGIN     RETURN SearchPos (s,p,0,len);
END Search;

PROCEDURE SearchNC* (s,p: ARRAY OF CHAR; len: LONGINT): LONGINT; (* $CopyArrays- *)
BEGIN     st.Upper(s); st.Upper(p); RETURN SearchPos (s,p,0,len);
END SearchNC;

END BoyerMoore.