IMPLEMENTATION MODULE GetFile;
(*
   Dieses Modul ist (C)'89 by Jens Pirnay
   Entstanden am  :  1990
   Funktion       :  Fileselect und diverse Filefunktionen
   Fehlerquellen  :  ???
   Žnderungen     :  17/11/90
   Benutzte Ideen :  eigene aus diversen Programmen
*)

(* Import list *)
FROM SYSTEM IMPORT ADDRESS, ADR, BYTE;

IMPORT mtAlerts ;
IMPORT Diverses ;
IMPORT MagicAES ;
IMPORT MagicDOS ;
IMPORT MagicStrings;
(**
IMPORT RTD;
**)
CONST AllFiles    = BITSET({MagicDOS.ReadOnly, MagicDOS.Hidden,
                            MagicDOS.Archive, MagicDOS.Volume});
      AllPlusDir  = BITSET({MagicDOS.ReadOnly, MagicDOS.Hidden,
                            MagicDOS.Archive, MagicDOS.Volume,
                            MagicDOS.Folder});
      ABCGEM      = 0210H;

VAR ExtendedFileSel : BOOLEAN;
    checked         : BOOLEAN;

(* --------------------- *)

PROCEDURE CheckVersion;
VAR vers : CARDINAL;
BEGIN
  IF NOT checked THEN
    vers := MagicDOS.Sversion();
    IF vers >= 01500H THEN
      vers := MagicAES.AESGlobal.apVersion;
      ExtendedFileSel := (vers >= 0120H) AND (vers<>ABCGEM);
     ELSE
      ExtendedFileSel := FALSE;
    END;
    checked := TRUE;
  END;
END CheckVersion;

(* --------------------- *)

PROCEDURE FileExists ( REF Filename : ARRAY OF CHAR ) : BOOLEAN;
(*
  Existiert die angegebene Datei? Wildcards erlaubt.
*)
VAR rc : INTEGER;
BEGIN
  rc := MagicDOS.Fsfirst(Filename, AllPlusDir);
  RETURN rc=0;
END FileExists;

(* --------------------- *)

PROCEDURE FileSize ( REF Filename : ARRAY OF CHAR ) : LONGCARD;
(*
  Liefert die Dateil„nge in Bytes zur�ck.
*)
VAR rc  : INTEGER;
    res : LONGCARD;
    ptr : MagicDOS.PtrDTA;
BEGIN
  ptr := MagicDOS.Fgetdta();
  rc  := MagicDOS.Fsfirst(Filename, AllFiles);
  IF rc=0 THEN
    res := ptr^.dLength;
   ELSE
    res := 0;
  END;
  RETURN res;
END FileSize;

(* --------------------- *)

PROCEDURE StdPath(VAR path : ARRAY OF CHAR);
VAR drive : CARDINAL;
    temp  : ARRAY [0..255] OF CHAR;
BEGIN
 drive := MagicDOS.Dgetdrv() ;
 MagicDOS.Dgetpath (temp, drive + 1);
(**
 RTD.Write('tmp', temp);
**)
 MagicStrings.Assign(' :', path);
 path[0] := CHR ( 65 + drive ) ;
 MagicStrings.Append (temp, path);
 temp := '\';
 MagicStrings.Append (temp, path);
(**
 RTD.Write('Result', path);
**)
END StdPath;

(* --------------------- *)

PROCEDURE AddExtension( VAR  FileName : ARRAY OF CHAR;
                        REF Extension : ARRAY OF CHAR );

VAR i, j, k : CARDINAL;
BEGIN
  i := 0;
  WHILE (i<=HIGH(FileName)) AND (FileName[i]<>0C) DO
    i := i + 1;
  END;
  IF i>=4 THEN
    j := i -4;
   ELSE
    j := 0;
  END;
  k := 0;
  WHILE (j<i) DO
    IF (FileName[j] = '.') THEN k := 1; END;
    IF (FileName[j] = '\') THEN k := 0; END;
    j := j + 1;
  END;
  IF k=0 THEN
    MagicStrings.Append(Extension, FileName);
  END;
END AddExtension;

(* --------------------- *)

PROCEDURE GetFileName(VAR FullFileName  : ARRAY OF CHAR;
                      VAR Filename      : ARRAY OF CHAR;
                      REF LookExtension : ARRAY OF CHAR;
                      REF StdExtension  : ARRAY OF CHAR;
                      VAR Startpath     : ARRAY OF CHAR;
                      REF TOS14Msg      : ARRAY OF CHAR;
                      VAR Exists        : BOOLEAN;
                          LeaveFilename : BOOLEAN;
                          HasToExist    : BOOLEAN;
                          ExtNeeded     : BOOLEAN;
                          WildcardOK    : BOOLEAN ) : BOOLEAN;
(*
   Liest via FileSelectorBox einen Dateinamen ein.
   F�gt falls gew�nscht ( ExtNeeded = TRUE ) eine Standard-Dateikennung
   an ( StdExtension ), sofern eine solche nicht bereits vorhanden ist.
   Ist der angegebene Startpfad ( Startpath ) leer, so wird zun„chst der
   Standard-Pfad benutzt.
   Zus„tzlich kann bei den TOS-Versionen ab 1.4 noch eine kleine Meldung
   am Kopf der FileSelectBox ausgegeben werden.
   Falls die gesuchte Datei existieren soll ( HasToExist = TRUE ), wird
   solange gefragt, bis eine g�ltige, existierende Datei angegeben wird.
   Zudem wird noch zur�ckgegeben, ob bereits eine Datei gleichen
   Namens existiert ( Exists ).
   Ist WildcardOK = TRUE so wird bei leerer Eingabe diese in "*.*"
   gewandelt. Sind schlužendlich im Namen Wildcards ("*", "?") vorhanden,
   so wird bei HasToExist �berpr�ft, ob es �berhaupt eine passende Datei
   gibt.
   Der voreingestellte Filename wird nur dann nicht gel”scht, wenn
   LeaveFilename = TRUE ist.
*)
VAR but, i, j     : INTEGER;
    drive         : CARDINAL;
    wildcards     : BOOLEAN;
    ready, result : BOOLEAN;
    temp          : ARRAY [0..1] OF CHAR;
    path          : ARRAY [0..255] OF CHAR;
    tos14msg      : ARRAY [0..255] OF CHAR;
    titeladr,
    fileadr,
    labeladr      : ADDRESS;
BEGIN
  CheckVersion;
  IF Startpath[0] = 0C THEN
    StdPath(Startpath);
  END;
  AddExtension(Startpath, LookExtension);
  IF NOT LeaveFilename THEN
    MagicStrings.Assign('', Filename);
   ELSE
    RemovePath ( Filename );
  END;

  REPEAT
    ready := TRUE;
    IF ExtendedFileSel THEN
      MagicStrings.Assign(TOS14Msg, tos14msg);
      result := MagicAES.FselExinput( tos14msg, Startpath, Filename);
     ELSE
      result := MagicAES.FselInput ( Startpath , Filename );
    END;
    IF result THEN
      IF WildcardOK AND (Filename[0] = 0C) THEN
        IF ExtNeeded THEN
          temp := '*';
          MagicStrings.Assign(temp, Filename);
         ELSE
          MagicStrings.Assign('*.*', Filename);
        END;
      END;
      IF ExtNeeded THEN
        AddExtension(Filename, StdExtension);
      END;

      wildcards := FALSE; (* Pr�fe auf Wildcards *)
      i := 0;
      WHILE (Filename[i]<>0C) DO
        IF (Filename[i]='*') OR (Filename[i]='?') THEN
          wildcards := TRUE;
        END;
        INC(i, 1);
      END;
      i := 0;
      j := -1;
      WHILE Startpath[i] <> 0C DO
        IF Startpath[i] = '\' THEN
          j := i;
        END;
        i := i + 1;
      END;
      MagicStrings.Copy(Startpath, 0, VAL(CARDINAL, j+1), FullFileName);
      MagicStrings.Append(Filename, FullFileName);
      IF NOT WildcardOK AND wildcards THEN
        ready := FALSE;
        mtAlerts.SetIcon(mtAlerts.File);
        but := Diverses.NumAlert (1, 1);
       ELSE
        Exists := FileExists(FullFileName);
        IF HasToExist AND NOT Exists THEN
          ready := FALSE;
          mtAlerts.SetIcon(mtAlerts.File);
(**
          but := Diverses.Alert ( 1 , NoFile );
**)
          but := Diverses.NumAlert (2, 1);
        END;
      END;
     ELSE
      MagicStrings.Assign('', FullFileName);
      MagicStrings.Assign('', Filename);
      Exists := FALSE;
    END;
  UNTIL ready;
  RETURN result;
END GetFileName;

(* --------------------- *)

PROCEDURE ReplaceFilename(VAR Target : ARRAY OF CHAR;
                          REF RepStr : ARRAY OF CHAR);
VAR i, j : INTEGER;
BEGIN
(*
  PDebug.Message('ReplaceFilename In:');
  PDebug.Message(Target);
*)
  i := 0;
  j := -1;
  WHILE (i<VAL(INTEGER, MagicStrings.Length(Target))) DO  (* letztes "\" suchen *)
    IF (Target[i] = ':') AND (j<0) THEN j := i; END; (* Laufwerk *)
    IF Target[i] = '\' THEN j := i; END;
    INC(i, 1);
  END;
  Target[j+1] := 0C;
  IF j<0 THEN
    MagicStrings.Assign(RepStr, Target);
   ELSE
    IF RepStr[0]<>0C THEN
      MagicStrings.Append(RepStr, Target);
    END;
  END;
(*
  PDebug.Message('ReplaceFilename Out:');
  PDebug.Message(Target);
*)
END ReplaceFilename;

(* --------------------- *)

PROCEDURE ReplaceExtension(VAR Target : ARRAY OF CHAR;
                           REF RepStr : ARRAY OF CHAR);
VAR i, j : INTEGER;
    temp : ARRAY [0..1] OF CHAR;
BEGIN
(*
  PDebug.Message('ReplaceExtension In:');
  PDebug.Message(Target);
*)
  i := VAL(INTEGER, MagicStrings.Length(Target)) - 1;
  WHILE (i>=0) AND (Target[i]<>'.') AND
       (Target[i]<>':') AND (Target[i]<>'\') DO
    DEC(i, 1);
  END;
  IF Target[i] = '.' THEN
    Target[i] := 0C;
  END;
  temp := '.';
  MagicStrings.Append(temp, Target);
  IF RepStr[0]<>0C THEN
    MagicStrings.Append(RepStr, Target);
  END;
(*
  PDebug.Message('ReplaceExtension Out:');
  PDebug.Message(Target);
*)
END ReplaceExtension;

(* --------------------- *)

PROCEDURE ReplacePath(VAR Target : ARRAY OF CHAR;
                      REF RepStr : ARRAY OF CHAR);
(*
  Ersetzt in Dateinamen den Pfad.
  Reiner Name bleibt dabei unangetastet.
*)
VAR temp : ARRAY [0..255] OF CHAR;
BEGIN
(*
  PDebug.Message('ReplacePath In:');
  PDebug.Message(Target);
*)
  MagicStrings.Assign(Target, temp);
  RemovePath(temp);
  MagicStrings.Assign(RepStr, Target);
  MagicStrings.Append(temp, Target);
(*
  PDebug.Message('ReplacePath Out:');
  PDebug.Message(Target);
*)
END ReplacePath;

(* --------------------- *)

PROCEDURE WildcardFile(REF Wildcard : ARRAY OF CHAR;
                           Action   : FileProc);
CONST maxfiles    = 127; (* Es werden alle Namen auf einmal eingelesen. *)

TYPE file     = ARRAY [0..13] OF CHAR;
VAR path      : ARRAY [0..255] OF CHAR;
    dummy     : ARRAY [0..255] OF CHAR;
    null      : ARRAY [0..1] OF CHAR;
    oldDTA    : ADDRESS;
    DTAbuffer : MagicDOS.DTA;
    i, j      : INTEGER;
    result    : INTEGER;
    nrfiles   : INTEGER;
    files     : ARRAY [0..maxfiles] OF file;

BEGIN
  nrfiles := -1;
  null := '';
  MagicStrings.Assign(Wildcard, path);
  ReplaceFilename(path, null); (* -> damit steht hier der reine Pfad *)

  oldDTA := MagicDOS.Fgetdta();
  MagicDOS.Fsetdta(ADR(DTAbuffer));
  result := MagicDOS.Fsfirst(Wildcard, AllFiles);
  WHILE (result=0) AND (nrfiles<maxfiles) DO
    INC(nrfiles, 1);
    MagicStrings.Assign( DTAbuffer.dFname, files[nrfiles]);
    result := MagicDOS.Fsnext();
  END;
  MagicDOS.Fsetdta(oldDTA);
  FOR i:=0 TO nrfiles DO
    MagicStrings.Assign(path, dummy);
    MagicStrings.Append(files[i], dummy);
(*
    PDebug.Message('WildcardFile:');
    PDebug.Message(dummy);
*)
    Action(dummy);
  END;
END WildcardFile;

(* --------------------- *)

PROCEDURE RemovePath(VAR file : ARRAY OF CHAR);
VAR i, beg, end, len : INTEGER;
BEGIN
(*
  PDebug.Message('RemovePath In:');
  PDebug.Message(file);
*)
  len := VAL(INTEGER, MagicStrings.Length(file));
  beg := -1;
  i   := 0;
  WHILE (i<len) DO
    IF (file[i] = ':') OR (file[i] = '\') THEN beg := i; END;
    INC(i, 1);
  END;
  IF beg>=0 THEN
    MagicStrings.Delete(file, 0, beg + 1);
  END;
(*
  PDebug.Message('RemovePath Out:');
  PDebug.Message(file);
*)
END RemovePath;

(* --------------------- *)

PROCEDURE Check(VAR file : ARRAY OF CHAR) : BOOLEAN;
VAR result    : BOOLEAN;
    temp      : ARRAY [0..255] OF CHAR;
    path      : ARRAY [0..255] OF CHAR;
    message   : ARRAY [0..255] OF CHAR;
    name      : ARRAY [0..39] OF CHAR;
    wildcrd,
    extens    : ARRAY [0..12] OF CHAR;
    null      : ARRAY [0..1] OF CHAR;
    button    : INTEGER;
    extneeded,
    ok, exist : BOOLEAN;
BEGIN
  IF FileExists(file) THEN
    button := Diverses.NumAlert (26, 1);
    IF button=1 THEN (* Neuer Name *)
      null := '';
      MagicStrings.Assign(file, temp);
      RemovePath(temp);
      MagicStrings.Assign(temp, name);
      MagicStrings.Assign(file, temp);
      ReplaceFilename(temp, '');
      MagicStrings.Assign(temp, path);
      (* Zun„chst suchen wir die Extension *)
      button := 0;
      WHILE (name[button]<>0C) AND (name[button]<>'.') DO
        INC(button);
      END;
      IF name[button]='.' THEN
        extneeded := TRUE;
        MagicStrings.Assign(name, extens);
        MagicStrings.Delete(extens, 0, button);
        wildcrd := '*';
        MagicStrings.Append(extens, wildcrd);
       ELSE
        extneeded := FALSE;
        extens  := '';
        wildcrd := '*.*';
      END;
      Diverses.GetFSelText(9, message);
      MagicStrings.Assign(file, temp);
      ok := GetFileName(temp, name, wildcrd, extens, path, message, exist,
                        TRUE, FALSE, extneeded, FALSE);
      IF ok THEN
        button := 0;
        MagicStrings.Assign(temp, file);
       ELSE
        button := 1;
      END;
    END;
    result := button = 0;
   ELSE
    result := TRUE;
  END;
  RETURN result;
END Check;

(* --------------------- *)

BEGIN
  checked := FALSE;
END (* of implementation module *) GetFile .