home *** CD-ROM | disk | FTP | other *** search
/ World of Sound / World of Sound.iso / utils / misc / fmsynth / src / source.lha / MyFileReq.mod < prev    next >
Encoding:
Text File  |  1993-06-28  |  6.1 KB  |  198 lines
  1.  
  2. (* Based on the original FileReq Module by Fridtjof Siebert *)
  3.  
  4. MODULE MyFileReq;
  5.  
  6. IMPORT str := Strings,
  7.        I   := Intuition,
  8.        e   := Exec,
  9.        asl := ASL,
  10.        u   := Utility,
  11.        sys := SYSTEM;
  12.  
  13.  
  14. (*------------------------------------------------------------------------*)
  15.  
  16. VAR
  17.   arpbase: e.LibraryPtr;
  18.   fr: asl.FileRequesterPtr;
  19.   pattern*: ARRAY 80 OF CHAR;
  20.   defaultWidth  * ,
  21.   defaultHeight * ,
  22.   defaultLeft   * ,
  23.   defaultTop    * : INTEGER;
  24.  
  25. (*------------------------------------------------------------------------*)
  26.  
  27.  
  28. PROCEDURE FileRequest      {arpbase,-294}(fr{8}: asl.FileRequesterPtr): BOOLEAN;
  29.  
  30.  
  31. (*------------------------------------------------------------------------*)
  32.  
  33.  
  34. PROCEDURE FR(    hail: ARRAY OF CHAR;
  35.              VAR name: ARRAY OF CHAR;
  36.                  save: BOOLEAN;
  37.                  win : I.WindowPtr): BOOLEAN;   (* $CopyArrays- *)
  38.  
  39. VAR
  40.   i,j: INTEGER;
  41.   Dirname: ARRAY 256 OF CHAR;
  42.   Filename: ARRAY 356 OF CHAR;
  43.   FR: STRUCT
  44.         hail:   e.ADDRESS;              (* Hailing text                 *)
  45.         file:    e.ADDRESS;             (* Filename array (FCHARS + 1)  *)
  46.         dir:    e.ADDRESS;              (* Directory array (DSIZE + 1)  *)
  47.         window: I.WindowPtr;            (* Window requesting or NULL    *)
  48.         funcFlags: SHORTSET;            (* Set bitdef's below           *)
  49.         flags2: SHORTSET;               (* New flags...                 *)
  50.         function: PROCEDURE();          (* Your function, see bitdef's  *)
  51.         leftEdge: INTEGER;              (* To be used later...          *)
  52.         topEdge: INTEGER;
  53.       END;
  54.   flags: LONGINT;
  55.   res: BOOLEAN;
  56.  
  57. BEGIN
  58.   LOOP
  59.     j := SHORT(str.Length(name));
  60.     WHILE (j>=0) & (name[j]#":") & (name[j]#"/") DO DEC(j) END;
  61.     i := 0;
  62.     WHILE i<=j DO Dirname[i] := name[i]; INC(i) END; Dirname[i] := 0X;
  63.     j := 0;
  64.     REPEAT Filename[j] := name[i]; INC(j); INC(i) UNTIL name[i-1]=0X;
  65.     IF asl.asl#NIL THEN
  66.       fr := asl.AllocFileRequest();
  67.       IF fr=NIL THEN EXIT END;
  68.  
  69.       flags := ASH(1,asl.patGad);
  70.       IF save THEN INC(flags,ASH(1,asl.save)) END;
  71.       res := asl.AslRequestTags(fr,
  72.                                 asl.leftEdge, defaultLeft,
  73.                                 asl.topEdge,  defaultTop,
  74.                                 asl.width,    defaultWidth,
  75.                                 asl.height,   defaultHeight,
  76.                                 asl.hail,     sys.ADR(hail),
  77.                                 asl.file,     sys.ADR(Filename),
  78.                                 asl.dir,      sys.ADR(Dirname),
  79.                                 asl.window,   win,
  80.                                 asl.pattern,  sys.ADR(pattern),
  81.                                 asl.funcFlags,flags,
  82.                                 u.done)#NIL;
  83.       COPY(fr.dir^,Dirname);
  84.       COPY(fr.file^,Filename);
  85.       asl.FreeFileRequest(fr); fr := NIL;
  86.       IF ~res THEN EXIT END;
  87.     ELSE
  88.       IF arpbase=NIL THEN
  89.         arpbase := e.OpenLibrary("arp.library",39);
  90.         IF arpbase = NIL THEN
  91.           sys.SETREG(0,I.DisplayAlert(0,
  92.             "\x00\x64\x14missing arp.library V39\o\o",50));
  93.           EXIT
  94.         END;
  95.       END;
  96.       FR.hail     := sys.ADR(hail);
  97.       FR.file     := sys.ADR(Filename);
  98.       FR.dir      := sys.ADR(Dirname);
  99.       FR.window   := win;
  100.       FR.funcFlags:= SHORTSET{};
  101.       IF save THEN INCL(FR.funcFlags,asl.save) END;
  102.       FR.flags2   := SHORTSET{0};
  103.       FR.function := NIL;
  104.       FR.leftEdge := defaultLeft;
  105.       FR.topEdge  := defaultTop;
  106.       IF ~FileRequest(sys.ADR(FR)) THEN EXIT END;
  107.     END;
  108.     i := SHORT(str.Length(Dirname));
  109.     IF (i>0) & (Dirname[i-1]#"/") & (Dirname[i-1]#":") THEN
  110.       Dirname[i] := "/"; INC(i);
  111.       Dirname[i] := 0X;
  112.     END;
  113.     IF LEN(name)>i+str.Length(Filename) THEN
  114.       COPY(Dirname,name);
  115.       str.Append(name,Filename);
  116.       RETURN TRUE;
  117.     END;
  118.     EXIT
  119.   END;
  120.   RETURN FALSE;
  121. END FR;
  122.  
  123.  
  124. (*------------------------------------------------------------------------*)
  125.  
  126.  
  127. PROCEDURE FileReqWinSave*(    hail: ARRAY OF CHAR;
  128.                           VAR name: ARRAY OF CHAR;
  129.                               win:  I.WindowPtr): BOOLEAN; (* $CopyArrays- *)
  130. (* öffnet ARP/ASL-FileRequester zum Speichern. Ergebnis ist FALSE wenn CANCEL
  131.  * gedrückt wurde oder der gewählte name zu lang ist.
  132.  * Beispiel: IF FileReqWinSave("Save File:",name,mywin) THEN Save(name) END;
  133.  *)
  134.  
  135. BEGIN RETURN FR(hail,name,TRUE,win) END FileReqWinSave;
  136.  
  137.  
  138. (*------------------------------------------------------------------------*)
  139.  
  140.  
  141. PROCEDURE FileReqSave*(    hail: ARRAY OF CHAR;
  142.                        VAR name: ARRAY OF CHAR): BOOLEAN; (* $CopyArrays- *)
  143. (* öffnet ARP/ASL-FileRequester zum Speichern. Ergebnis ist FALSE wenn CANCEL
  144.  * gedrückt wurde oder der gewählte name zu lang ist.
  145.  * Beispiel: IF FileReqSave("Save File:",name) THEN Save(name) END;
  146.  *)
  147.  
  148. BEGIN RETURN FR(hail,name,TRUE,NIL) END FileReqSave;
  149.  
  150.  
  151. (*------------------------------------------------------------------------*)
  152.  
  153.  
  154. PROCEDURE FileReqWin*(    hail: ARRAY OF CHAR;
  155.                       VAR name: ARRAY OF CHAR;
  156.                           win:  I.WindowPtr): BOOLEAN; (* $CopyArrays- *)
  157. (* öffnet ARP/ASL-FileRequester zum Laden. Ergebnis ist FALSE wenn CANCEL
  158.  * gedrückt wurde oder der gewählte name zu lang ist.
  159.  * Beispiel: IF FileReqWin("Load File:",name,mywin) THEN Load(name) END;
  160.  *)
  161.  
  162. BEGIN RETURN FR(hail,name,FALSE,win) END FileReqWin;
  163.  
  164.  
  165. (*------------------------------------------------------------------------*)
  166.  
  167.  
  168. PROCEDURE FileReq*(    hail: ARRAY OF CHAR;
  169.                    VAR name: ARRAY OF CHAR): BOOLEAN; (* $CopyArrays- *)
  170. (* öffnet ARP/ASL-FileRequester zum Laden. Ergebnis ist FALSE wenn CANCEL
  171.  * gedrückt wurde oder der gewählte name zu lang ist.
  172.  * Beispiel: IF FileReq("Load File:",name) THEN Load(name) END;
  173.  *)
  174.  
  175. BEGIN RETURN FR(hail,name,FALSE,NIL) END FileReq;
  176.  
  177.  
  178. (*------------------------------------------------------------------------*)
  179.  
  180.  
  181. BEGIN
  182.  
  183.   defaultTop   := 20;
  184.   defaultLeft  := 20;
  185.   defaultWidth := 300;
  186.   defaultHeight:= 180;
  187.  
  188.   pattern := "~(#?.info)";
  189.  
  190. CLOSE
  191.  
  192.   IF fr     #NIL THEN asl.FreeFileRequest(fr)  END;
  193.   IF arpbase#NIL THEN e.CloseLibrary(arpbase) END;
  194.  
  195. END MyFileReq.
  196.  
  197.  
  198.