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