(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*  Amiga Oberon Library Module: FileReq              Date: 02-Nov-92      *)
(*                                                                         *)
(*   © 1992 by Fridtjof Siebert                                            *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

MODULE MyFileReq;

IMPORT str := Strings,
       I   := Intuition,
       e   := Exec,
       asl := ASL,
       u   := Utility,
       sys := SYSTEM;


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

VAR
  arpbase: e.LibraryPtr;
  fr: asl.FileRequesterPtr;
  pattern*: ARRAY 80 OF CHAR;
  defaultWidth  * ,
  defaultHeight * ,
  defaultLeft   * ,
  defaultTop    * : INTEGER;

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


PROCEDURE FileRequest      {arpbase,-294}(fr{8}: asl.FileRequesterPtr): BOOLEAN;


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


PROCEDURE FR(    hail: ARRAY OF CHAR;
             VAR name: ARRAY OF CHAR;
                 save: BOOLEAN;
                 win : I.WindowPtr): BOOLEAN;   (* $CopyArrays- *)

VAR
  i,j: INTEGER;
  Dirname: ARRAY 256 OF CHAR;
  Filename: ARRAY 356 OF CHAR;
  FR: STRUCT
        hail:   e.ADDRESS;              (* Hailing text                 *)
        file:    e.ADDRESS;             (* Filename array (FCHARS + 1)  *)
        dir:    e.ADDRESS;              (* Directory array (DSIZE + 1)  *)
        window: I.WindowPtr;            (* Window requesting or NULL    *)
        funcFlags: SHORTSET;            (* Set bitdef's below           *)
        flags2: SHORTSET;               (* New flags...                 *)
        function: PROCEDURE();          (* Your function, see bitdef's  *)
        leftEdge: INTEGER;              (* To be used later...          *)
        topEdge: INTEGER;
      END;
  flags: LONGINT;
  res: BOOLEAN;

BEGIN
  LOOP
    j := SHORT(str.Length(name));
    WHILE (j>=0) & (name[j]#":") & (name[j]#"/") DO DEC(j) END;
    i := 0;
    WHILE i<=j DO Dirname[i] := name[i]; INC(i) END; Dirname[i] := 0X;
    j := 0;
    REPEAT Filename[j] := name[i]; INC(j); INC(i) UNTIL name[i-1]=0X;
    IF asl.asl#NIL THEN
      fr := asl.AllocFileRequest();
      IF fr=NIL THEN EXIT END;

      flags := ASH(1,asl.patGad);
      IF save THEN INC(flags,ASH(1,asl.save)) END;
      res := asl.AslRequestTags(fr,
                                asl.leftEdge, defaultLeft,
                                asl.topEdge,  defaultTop,
                                asl.width,    defaultWidth,
                                asl.height,   defaultHeight,
                                asl.hail,     sys.ADR(hail),
                                asl.file,     sys.ADR(Filename),
                                asl.dir,      sys.ADR(Dirname),
                                asl.window,   win,
                                asl.pattern,  sys.ADR(pattern),
                                asl.funcFlags,flags,
                                u.done)#NIL;
      COPY(fr.dir^,Dirname);
      COPY(fr.file^,Filename);
      asl.FreeFileRequest(fr); fr := NIL;
      IF ~res THEN EXIT END;
    ELSE
      IF arpbase=NIL THEN
        arpbase := e.OpenLibrary("arp.library",39);
        IF arpbase = NIL THEN
          sys.SETREG(0,I.DisplayAlert(0,
            "\x00\x64\x14missing arp.library V39\o\o",50));
          EXIT
        END;
      END;
      FR.hail     := sys.ADR(hail);
      FR.file     := sys.ADR(Filename);
      FR.dir      := sys.ADR(Dirname);
      FR.window   := win;
      FR.funcFlags:= SHORTSET{};
      IF save THEN INCL(FR.funcFlags,asl.save) END;
      FR.flags2   := SHORTSET{0};
      FR.function := NIL;
      FR.leftEdge := defaultLeft;
      FR.topEdge  := defaultTop;
      IF ~FileRequest(sys.ADR(FR)) THEN EXIT END;
    END;
    i := SHORT(str.Length(Dirname));
    IF (i>0) & (Dirname[i-1]#"/") & (Dirname[i-1]#":") THEN
      Dirname[i] := "/"; INC(i);
      Dirname[i] := 0X;
    END;
    IF LEN(name)>i+str.Length(Filename) THEN
      COPY(Dirname,name);
      str.Append(name,Filename);
      RETURN TRUE;
    END;
    EXIT
  END;
  RETURN FALSE;
END FR;


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


PROCEDURE FileReqWinSave*(    hail: ARRAY OF CHAR;
                          VAR name: ARRAY OF CHAR;
                              win:  I.WindowPtr): BOOLEAN; (* $CopyArrays- *)
(* öffnet ARP/ASL-FileRequester zum Speichern. Ergebnis ist FALSE wenn CANCEL
 * gedrückt wurde oder der gewählte name zu lang ist.
 * Beispiel: IF FileReqWinSave("Save File:",name,mywin) THEN Save(name) END;
 *)

BEGIN RETURN FR(hail,name,TRUE,win) END FileReqWinSave;


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


PROCEDURE FileReqSave*(    hail: ARRAY OF CHAR;
                       VAR name: ARRAY OF CHAR): BOOLEAN; (* $CopyArrays- *)
(* öffnet ARP/ASL-FileRequester zum Speichern. Ergebnis ist FALSE wenn CANCEL
 * gedrückt wurde oder der gewählte name zu lang ist.
 * Beispiel: IF FileReqSave("Save File:",name) THEN Save(name) END;
 *)

BEGIN RETURN FR(hail,name,TRUE,NIL) END FileReqSave;


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


PROCEDURE FileReqWin*(    hail: ARRAY OF CHAR;
                      VAR name: ARRAY OF CHAR;
                          win:  I.WindowPtr): BOOLEAN; (* $CopyArrays- *)
(* öffnet ARP/ASL-FileRequester zum Laden. Ergebnis ist FALSE wenn CANCEL
 * gedrückt wurde oder der gewählte name zu lang ist.
 * Beispiel: IF FileReqWin("Load File:",name,mywin) THEN Load(name) END;
 *)

BEGIN RETURN FR(hail,name,FALSE,win) END FileReqWin;


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


PROCEDURE FileReq*(    hail: ARRAY OF CHAR;
                   VAR name: ARRAY OF CHAR): BOOLEAN; (* $CopyArrays- *)
(* öffnet ARP/ASL-FileRequester zum Laden. Ergebnis ist FALSE wenn CANCEL
 * gedrückt wurde oder der gewählte name zu lang ist.
 * Beispiel: IF FileReq("Load File:",name) THEN Load(name) END;
 *)

BEGIN RETURN FR(hail,name,FALSE,NIL) END FileReq;


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


BEGIN

  defaultTop   := 20;
  defaultLeft  := 20;
  defaultWidth := 300;
  defaultHeight:= 180;

  pattern := "~(#?.info)";

CLOSE

  IF fr     #NIL THEN asl.FreeFileRequest(fr)  END;
  IF arpbase#NIL THEN e.CloseLibrary(arpbase) END;

END MyFileReq.