(********************************************************************
  :Program.       mcd.mod
  :Author.        Ludwig Geromiller
  :Address.       Filderstr. 63, 7000 Stuttgart 1
  :Phone.         0711/6409664
  :History.       V2.0, Nov-89, Ludwig Geromiller
  :Copyright.     PD
  :Language.      Modula-II
  :Translator.    M2Amiga 3.2d
  :Imports.       Nix
  :Contents.      My cd: ermöglicht Directorywechsel mit Wildcards
  :Contents.      und ohne Angabe des gesamten Pfadnamens
  :Contents.      Funktion ähnlich wie Norton-cd auf IBM-PC`s
  :Usage.         Aufruf aus CLI: z.B. mcd Diam#? oder mcd Diamo*
  :Usage.         (springt direkt ins Verzeichnis :fonts/Diamond)
  :Remark.        Die Datei :Tree.mcd enthält die Directorystruktur und
  :Remark.        wird mittels mcdTree >:Tree.mcd angelegt
  :Remark.        (s.a. mcdTree.mod)
********************************************************************)

MODULE mcd;

FROM Arguments  IMPORT NumArgs, GetArg;
FROM Arts       IMPORT Assert, TermProcedure, Terminate;
FROM ASCII      IMPORT csi, cr;
FROM Str        IMPORT Length, Concat, Compare,CapString,
                       CopyPos, FirstPos, noOccur;
FROM Strings    IMPORT Occurs, first, last, Delete, Insert;
FROM SYSTEM     IMPORT ADDRESS, ADR, CAST, BPTR;
FROM Terminal   IMPORT Write, WriteString, WriteLn;
FROM InOut      IMPORT WriteInt, WriteCard;
FROM Dos        IMPORT BSTR, FileInfoBlock, FileInfoBlockPtr, UnLock,
                       FileLock, CurrentDir, FileHandlePtr, Execute,
                       FileLockPtr, sharedLock, Lock, Examine, ExNext,
                       ProcessPtr;
FROM Exec       IMPORT AllocMem, FreeMem, MemReqs, MemReqSet, Task,
                       TaskPtr, FindTask;
IMPORT Dos;
IMPORT FileSystem;

TYPE String     = ARRAY [0..107] OF CHAR;
     Position = (front,back,both);
     Entry = RECORD
                Level   : CARDINAL;
                Dirname : String;
             END; (* RECORD *)
VAR Match : PROCEDURE(ARRAY OF CHAR):BOOLEAN;
        (* globale Prozedurvariable
                falls kein Muster -> Match := Equal
                falls Muster      -> Match := Pattern
        *)
    newDir, argDir, oldDir : String;
    argnumber,arglength    : INTEGER;
    oldcdptr, newcdptr     : FileLockPtr;
    erfolg, found, root    : BOOLEAN;
    erf                    : LONGINT;
    deleteLine             : ARRAY [0..2] OF CHAR;
       (* Steuerzeichen für Console *)
    patpos                 : Position;
    ProcPtr                : ProcessPtr;
    taskPtr                : TaskPtr;
    i, oldLevel            : CARDINAL;
    laenge, anz, Startadr,
    Index, merk            : LONGINT;
    file                   : FileSystem.File;
    HandlePtr              : FileHandlePtr;
    altdir, neudir         : Entry;
    chrPtr                 : POINTER TO CHAR;
    Zeichen                : CHAR;


PROCEDURE Ausstieg;
  BEGIN
    IF (Startadr#NIL) THEN
      FreeMem(Startadr,laenge);
      Startadr:=NIL
    END; (* IF *)
    Write(csi);WriteString(" p");
  END Ausstieg;

PROCEDURE SetNewCD (newDir:ARRAY OF CHAR);
BEGIN
  newcdptr:=Lock(ADR(newDir), sharedLock);
  oldcdptr := CurrentDir (newcdptr);
  IF newcdptr # NIL THEN
    IF oldcdptr # NIL THEN
      UnLock (oldcdptr);
      found:=TRUE
    END; (* IF *)
    i:=0;
    REPEAT
      INC(i);
      ProcPtr^.cli^.setName^[i] := newDir[i-1];
    UNTIL newDir[i]=0C;
    ProcPtr^.cli^.setName^[0] := CHAR(i);
  END; (* IF *)
END SetNewCD;

PROCEDURE BSTRtoString(bstr:BSTR; VAR string: ARRAY OF CHAR);
  VAR aptr   : POINTER TO String;
      counter: CARDINAL;
  BEGIN
    aptr := ADDRESS(CAST(BPTR,bstr));
    IF CARDINAL(aptr^[0]) = 0 THEN
      string:="";
      RETURN
    END; (* IF *)
    FOR counter:=0 TO CARDINAL(aptr^[0])-1 DO
      string[counter]:=aptr^[counter+1]
    END; (* FOR *)
    string[ORD(aptr^[0])] := 0C
  END BSTRtoString;

PROCEDURE Equal(string:ARRAY OF CHAR):BOOLEAN;
  BEGIN
    CapString(string);
    IF Compare(string,argDir)=0 THEN
      RETURN TRUE
    ELSE
      RETURN FALSE
    END (* IF *)
  END Equal;

PROCEDURE Pattern(string:ARRAY OF CHAR):BOOLEAN;
    VAR pos :INTEGER;
  BEGIN
    CapString(string);
    pos := Occurs(string,0,argDir,FALSE);
    IF pos # last THEN
      CASE patpos OF
        both  : RETURN TRUE |
        front : IF CARDINAL(pos) = Length(string)-Length(argDir) THEN
                  RETURN TRUE
                ELSE
                  RETURN FALSE
                END|
        back  : IF pos = 0 THEN
                  RETURN TRUE
                ELSE
                  RETURN FALSE
                END
      END; (* CASE *)
    ELSE
      RETURN FALSE
    END (* IF *)
  END Pattern;

PROCEDURE ReadTree();
  BEGIN (* ReadTree *)
    FileSystem.Lookup(file,":Tree.mcd",0,FALSE);
    IF file.res=FileSystem.notFound THEN (*Datei :Tree.mcd nicht gefunden*)
      WriteString("Plattenanalyse! Please Wait.....");WriteLn;
      HandlePtr := Dos.Open(ADR(":Tree.mcd"),Dos.newFile);
      erf:=Execute(ADR("mcdTree"),NIL,HandlePtr);
    (* mcdtree>:Tree.mcd *)
      Dos.Close(HandlePtr);
      FileSystem.Lookup(file,":Tree.mcd",0,FALSE);
    END; (* IF *)
    FileSystem.Length (file,laenge);
    FileSystem.Close(file);
    Startadr := LONGINT(AllocMem(laenge,MemReqSet{chip}));
    Assert(Startadr#NIL,ADR("zu wenig Speicher"));
    HandlePtr := Dos.Open(ADR(":Tree.mcd"),1005);
    anz := Dos.Read(HandlePtr,Startadr,laenge);
    Assert(anz=laenge,ADR("Fehler beim Lesen"));
    Dos.Close(HandlePtr);
    Index := Startadr;
  END ReadTree;

PROCEDURE ReadEntry(VAR entry: Entry; VAR Index:LONGINT);
 (* Liefert Entry an der Stelle Index *)
  BEGIN
    INC(Index);
    Assert(Index<=Startadr+laenge,ADR("ReadEntry Index zu hoch!"));
    chrPtr:=ADDRESS(Index);
    entry.Level := CARDINAL(chrPtr^)-48;

    INC(Index,3);
    chrPtr:=ADDRESS(Index);
    i:=0;
    REPEAT
      entry.Dirname[i]:=chrPtr^;
      INC(i);INC(Index);
      Assert(Index<=Startadr+laenge,ADR("ReadEntry Index zu hoch!"));
      chrPtr:=ADDRESS(Index);
    UNTIL chrPtr^=12C;
    entry.Dirname[i]:=0C;
    INC(Index);
  END ReadEntry;

PROCEDURE Backspace(VAR Index:LONGINT); (* setzt Index um einen Entry zurück *)
  BEGIN
    DEC(Index,4);
    REPEAT
      DEC(Index);
      Assert(Index>=Startadr,ADR("Backspace Index zu klein!"));
      chrPtr:=ADDRESS(Index);
    UNTIL(chrPtr^=12C); (* REPEAT *)
    INC(Index);
  END Backspace;

PROCEDURE altDir();  (* Liefert Index merk vom alten Dir in Tree.mcd *)
  VAR pos,start: INTEGER;
      lastCh   : CHAR;
  BEGIN
    Index := Startadr; (* init *)
    merk:= Startadr;
    pos :=0; start:=0;
    LOOP
      REPEAT
        ReadEntry(altdir,Index);
        WriteString(altdir.Dirname); WriteString(deleteLine);
        pos := Occurs(oldDir,start,altdir.Dirname,TRUE);
        lastCh := oldDir[start+INTEGER(Length(altdir.Dirname))];
        IF (Index>=Startadr+laenge-1) THEN (* Fileende Tree.mcd *)
          IF (CARDINAL(start)<Length(oldDir)) THEN
            WriteString("Aktuelles Directory nicht in Tree.mcd gefunden!");WriteLn;
            WriteString("Jetzt kommt Directoryscan for Tree.mcd mittels mcdTree");
            WriteLn; WriteString("Bitte warten..."); WriteLn;
            HandlePtr := Dos.Open(ADR(":Tree.mcd"),Dos.newFile);
            erf:=Execute(ADR("mcdTree"),NIL,HandlePtr);
          (* mcdtree>:Tree.mcd *)
            Dos.Close(HandlePtr); Ausstieg;
            ReadTree; altDir; EXIT;
            HALT;
          ELSE
            EXIT
          END; (* IF *)
        END; (* IF *)
      UNTIL (pos=start) AND ((lastCh=0C)OR(lastCh=":")OR(lastCh="/"));
            (* bis vollständ. Name gefunden *)
      start:= pos+INTEGER(Length(altdir.Dirname))+1; (* 1 wegen :,/ *)
      IF CARDINAL(start)>=Length(oldDir) THEN
        merk := Index; (* ab hier wird nach neuem Directory gesucht *)
        EXIT
      END; (* IF *)
    END; (* LOOP *)
  END altDir;

PROCEDURE DirSearch(); (* scan for Index neues Dir *)
  VAR entry:Entry;
  BEGIN
    WHILE NOT Match(neudir.Dirname) DO
      ReadEntry(neudir,Index);
      IF ((Index>Startadr+laenge-1) AND (anz=laenge)) THEN
        Index:=Startadr;
        INC(anz,laenge);
      ELSIF ((anz>laenge) AND (merk<Index)) THEN
        WriteString("Neues Directory nicht in Tree.mcd gefunden!"); WriteLn;
        (* Hier kommt später eine Bewertung nach WLD
                     (gewichtete Levenstein-Distanz) des Dir-namens *)
        WriteLn; Terminate(10);
      END; (* IF *)
    END; (* WHILE *)
    found    := TRUE;
    merk     := Index;
    newDir   := neudir.Dirname;
    oldLevel := neudir.Level;
    WHILE (oldLevel>1) DO
      Insert(newDir,0,"/");
      REPEAT
        Backspace(Index); Backspace(Index);
        ReadEntry(entry,Index);
      UNTIL (entry.Level=oldLevel-1);
      oldLevel := entry.Level;
      Insert(newDir,0,entry.Dirname);
    END; (* WHILE *)
    WriteString("Changing to "); WriteString(newDir);WriteLn;
    Insert(newDir,0,":");
    Index:=Startadr;
    ReadEntry(entry,Index);
    Insert(newDir,0,entry.Dirname);
    SetNewCD(newDir);
  END DirSearch;

BEGIN (* mcd *)
  TermProcedure(Ausstieg);
  argnumber := NumArgs();
  IF argnumber = 1 THEN
    GetArg(1,argDir,arglength);
    IF argDir[0] ="?" THEN
      WriteString("Eingabe:  mcd [DIR]"); WriteLn;
      WriteString(" - Muster für [DIR]: ");
      WriteString("[#?]Zeichenfolge[#?] oder [*]Zeichenfolge[*]");
      WriteLn;
      Terminate(0);
    END; (* IF *)
  ELSE
    WriteString("Eingabe:  mcd [DIR]"); WriteLn;
    WriteString(" - Muster für [DIR]: ");
    WriteString("[#?]Zeichenfolge[#?] oder [*]Zeichenfolge[*]");
    WriteLn;
    Terminate(0);
  END; (* IF *)

CapString(argDir);

  IF (Occurs(argDir,0,"#?",FALSE)=last) AND
     (Occurs(argDir,0,"*",FALSE)=last) THEN
    Match := Equal
  ELSE
    Match := Pattern;
    patpos := back;

    IF FirstPos(argDir,0,"#")=0 THEN
      Delete(argDir,0,2);
      patpos := front
    ELSIF FirstPos(argDir,0,"*")=0 THEN
      Delete(argDir,0,1);
      patpos := front
    END; (* IF *)

    IF FirstPos(argDir,0,"#")= LONGINT(Length(argDir)-2) THEN
      Delete(argDir,Length(argDir)-2,2);
      IF patpos = front THEN
        patpos := both
      END (* IF *)
    END; (* IF *)

    IF FirstPos(argDir,0,"*")= LONGINT(Length(argDir)-1) THEN
      Delete(argDir,Length(argDir)-1,1);
      IF patpos = front THEN
        patpos := both
      END (* IF *)
    END; (* IF *)

  END; (* IF *)
  Write(csi); WriteString("0 p"); (* Cursor Aus *)
  Write(csi); WriteString("1;33;42m");
  WriteString("My-cd V2.0 by ---- Gero-Soft ---- ");
  Write(csi); WriteString("0;31;40m"); WriteLn;WriteLn;
  deleteLine[0] := cr;
  deleteLine[1] := csi;
  deleteLine[2] := "K";

  taskPtr := FindTask(NIL);
  ProcPtr := ADR(taskPtr^);
  BSTRtoString(ProcPtr^.cli^.setName,oldDir);

  found := FALSE;
  ReadTree;
  altDir(); (* such ab Start nach altem Dir oldDir *)

  DirSearch(); (* such ab merk nach argDir; wenn Dateiende von vorn suchen *)

  IF NOT found THEN
    WriteString("Es wurde kein zu `");
    WriteString(argDir);
    WriteString("` passender Eintrag gefunden!");
    WriteLn
  END (* IF *)
END mcd.mod