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

MODULE FileReq;

IMPORT str := Strings,
       I   := Intuition,
       e   := Exec,
       asl := ASL,
              Dos,
       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;

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;
  l,t,w,h: INTEGER;

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

      IF fr=NIL THEN
        l := defaultLeft;
        t := defaultTop;
        w := defaultWidth;
        h := defaultHeight;
        IF win#NIL THEN
          IF win.width  - 40 > w THEN l := win.leftEdge + 20; w := win.width  - 40; IF w>320 THEN w := 320 END END;
          IF win.height - 40 > h THEN t := win.topEdge  + 20; h := win.height - 40 END;
        END;
        fr := asl.AllocAslRequestTags(asl.fileRequest,
                                      asl.leftEdge,l,
                                      asl.topEdge, t,
                                      asl.width,   w,
                                      asl.height,  h,
                                      u.done);
        IF fr=NIL THEN HALT(20) END;
      END;
    
      flags := ASH(1,asl.patGad);
      IF save THEN INC(flags,ASH(1,asl.save)) END;
      res := asl.AslRequestTags(fr,
                                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);
      COPY(fr.dir^,Dirname);
      COPY(fr.file^,Filename);
      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));
          HALT(0)
        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 := 0;
      FR.topEdge  := 0;
      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;
  END;
  RETURN FALSE;
END FR;


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


PROCEDURE FileReqWinSave*(    hail: ARRAY OF CHAR;
                          VAR name: ARRAY OF CHAR;
                              win:  I.WindowPtr): BOOLEAN;
(* ö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;
(* ö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;
(* ö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;
(* ö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)";

  IF asl.asl=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));
      HALT(0)
    END;
  END;

CLOSE

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

END FileReq.