(*---------------------------------------------------------------------------
    :Program.    TwoFiles.mod
    :Author.     Bernd Preusing
    :Address.    Gerhardstr. 16  D-2200 Elmshorn
    :Phone.      04121/22486
    :Shortcut.   [bep]
    :Version.    1.1
    :Date.       11-Nov-88
    :Copyright.  PD
    :Language.   Modula-II
    :Translator. M2Amiga
    :Imports.    InOut2 [bep]
    :UpDate.     1.1: Added InMessage and OutMessage
    :Contents.   Open Input and/or Output from commandline or Terminal
    :Remark.
---------------------------------------------------------------------------*)
IMPLEMENTATION MODULE TwoFiles;

FROM SYSTEM IMPORT
	ADR;

FROM Arguments IMPORT
	NumArgs, GetArg;

FROM Terminal IMPORT
	ReadLn, Write, WriteString, WriteLn;

FROM InOut2 IMPORT
	done, SetInput, SetOutput, CloseInput, CloseOutput;

FROM Dos IMPORT
	FileLockPtr, oldFile, Lock, UnLock;

(* ============================================================
 from Def-Module:
TYPE
	sFileName = ARRAY[0..79] OF CHAR;

	(* bekommt den '-'-Parameter incl. '-' *)
	prOpt = PROCEDURE(VAR ARRAY OF CHAR);

VAR	(* nur zum Auslesen *)
	InFileName, OutFileName: sFileName;

	(* zum Setzen der Msgs. Default: 'in>' und 'out>' *)
	InMessage, OutMessage: sFileName;
============================================================ *)

CONST
	msNotFound = ': nicht gefunden';
	msNotOpen  = ': nicht zu öffnen';


VAR
	Args,
	ActArg: INTEGER;
	InterActive, Dir: BOOLEAN;
	OptProc: prOpt;
	Ask: BOOLEAN;


PROCEDURE OptProcedure(p: prOpt);
BEGIN
  OptProc:=p
END OptProcedure;

PROCEDURE SetAsk(ask: BOOLEAN);
BEGIN
  Ask:=ask
END SetAsk;

(* $F- *)

PROCEDURE FileExists(VAR name: ARRAY OF CHAR): BOOLEAN;
VAR lock: FileLockPtr;
BEGIN
  lock:=Lock(ADR(name),oldFile);
  IF lock=NIL THEN
    RETURN FALSE
  ELSE
    UnLock(lock);
    RETURN TRUE
  END
END FileExists;

PROCEDURE GetName(VAR str, msg: sFileName; test: BOOLEAN): BOOLEAN;
VAR len,dummy:INTEGER;
    ok: BOOLEAN;
    Answer: CHAR; line:ARRAY[0..0] OF CHAR; (* weil Read spinnt muß ReadLn! *)
BEGIN
  REPEAT
    ok:=TRUE; Dir:=FALSE;
    WriteString(msg);
    IF InterActive THEN
      ReadLn(str,len)
    ELSE
      GetArg(ActArg,str,len);
      IF (len=0) AND (ActArg<=Args) THEN (* Workbench: Directory oder Device *)
        str:='>DIRECTORY<';
        Dir:=TRUE;
        len:=11
      END;
      INC(ActArg);
      WriteString(str); WriteLn
    END;
    IF (OptProc#NIL) AND (len>0) AND (str[0]='-') THEN
      ok:=FALSE;
      OptProc(str)
    ELSIF test AND (len>0) AND FileExists(str) THEN
      REPEAT
        Write(07C); (* Beep *)
        WriteString('Existiert bereits! Überschreiben (JY/N)?');
        ReadLn(line,dummy); Answer:=CAP(line[0]);
      UNTIL (Answer='J') OR (Answer='Y') OR (Answer='N');
      ok:=(Answer#'N');
      IF NOT ok THEN InterActive:= TRUE END; (* jetzt von Terminal *)
    END;
  UNTIL ok;
  RETURN len>0
END GetName;

PROCEDURE OpenFiles(in, out: BOOLEAN): BOOLEAN;
BEGIN
  IF in THEN
    CloseInput;
    REPEAT
      IF NOT GetName(InFileName,InMessage,FALSE) THEN RETURN FALSE END;
      SetInput(InFileName);
      IF NOT done THEN
        InterActive:=TRUE;
        WriteString(InFileName); WriteString(msNotFound); WriteLn
      END;
    UNTIL done;
  END;
  IF out THEN
    CloseOutput;
    REPEAT
      IF GetName(OutFileName,OutMessage,Ask) THEN
        IF NOT Dir THEN
          SetOutput(OutFileName); (* erzeugt sonst File >DIRECTORY< *)
        ELSE
          done:=FALSE (* nicht die feine Art, ich weiß *)
        END;
        IF NOT done THEN
          InterActive:=TRUE;
          WriteString(OutFileName); WriteString(msNotOpen); WriteLn
        END;
      ELSE (* name leer *)
        IF in THEN (* 2.Para leer: gibt out nach Terminal *)
	  OutFileName:='*';
          done:=TRUE (* nicht die feine Art, ich weiß *)
	ELSE (* 1. Para leer: Ende *)
	  RETURN FALSE
	END
      END;
    UNTIL done;
  END;
  RETURN TRUE
END OpenFiles;


BEGIN
  Args:=NumArgs();
  InterActive:=(Args=0);
  ActArg:=1;
  InFileName:='';
  OutFileName:=InFileName;
  InMessage:='in> ';
  OutMessage:='out> ';
  OptProc:=NIL;
  Ask:=TRUE;
END TwoFiles.mod