home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / amiga / programm / libs / reqtools.lha / ReqTools / Glue / M2Amiga / ReqTFileReq.mod < prev    next >
Encoding:
Modula Implementation  |  1992-06-29  |  2.5 KB  |  86 lines
  1. (*---------------------------------------------------------------------------
  2.   :Program.    ReqTFileReq.mod
  3.   :Contents.   Simple Benutzung des ReqTools Filerequesters
  4.   :Author.     Frank L÷mker
  5.   :Copyright.  Public Domain
  6.   :Language.   Modula-2
  7.   :Translator. M2Amiga V4.0d
  8.   :Support.    Basiert zu gro▀en Teilen auf ARPFileReq von Bernd Preu▀ing
  9.   :Imports.    ReqTools 1.0m [kai]
  10.   :History.    V1.0, [Frank L÷mker] 24-Feb-92
  11.   :Bugs.       keine bekannt
  12. ---------------------------------------------------------------------------*)
  13. IMPLEMENTATION MODULE ReqTFileReq;
  14.  
  15. (*$ LargeVars:=FALSE StackParms:=FALSE RangeChk:=FALSE OverflowChk:=FALSE
  16.     ReturnChk:=FALSE StackChk:=FALSE EntryClear:=FALSE *)
  17.  
  18. FROM UtilityD IMPORT tagEnd;
  19. FROM SYSTEM   IMPORT ADR, ADDRESS,TAG;
  20. FROM String   IMPORT Copy, LastPos, Length, Concat;
  21. IMPORT rt:ReqTools;
  22.  
  23. TYPE str110=ARRAY [0..110] OF CHAR;
  24.      str110Ptr=POINTER TO str110;
  25.  
  26. VAR filereq:rt.FileRequesterPtr;
  27.     tagbuf:ARRAY [0..5] OF LONGINT;
  28.     File, Dir: str110;
  29.  
  30. PROCEDURE GetPath(VAR f,d:ARRAY OF CHAR);
  31. VAR pos,i:INTEGER;
  32. BEGIN
  33.   Copy(d,f);
  34.   pos:=LastPos(f,1000,'/');
  35.   IF pos<0 THEN
  36.     pos:=LastPos(f,1000,':');
  37.   END;
  38.   IF pos>=0 THEN
  39.     IF d[pos]=':' THEN d[pos+1]:=0C ELSE d[pos]:=0C END;
  40.     INC(pos);
  41.     FOR i:=pos TO Length(f) DO
  42.       f[i-pos]:=f[i]
  43.     END;
  44.     f[i]:=0C;
  45.   ELSE
  46.     d[0]:=0C
  47.   END;
  48. END GetPath;
  49.  
  50. PROCEDURE FileReq (VAR FName:ARRAY OF CHAR; Window:ADDRESS; Title:ARRAY OF CHAR;
  51.                    x,y:INTEGER; pattern:ARRAY OF CHAR):BOOLEAN;
  52. BEGIN
  53.   filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
  54.   IF filereq # NIL THEN
  55.     Copy (File,FName);
  56.     GetPath (File,Dir);
  57.     IF Length (pattern)>0 THEN
  58.       rt.ChangeReqAttrA (filereq,TAG(tagbuf,rt.fiDir,ADR(Dir),
  59.                                         rt.fiMatchPat,ADR(pattern),tagEnd));
  60.       INCL (filereq^.flags, rt.fReqPatGad);
  61.     ELSE
  62.       rt.ChangeReqAttrA (filereq,TAG(tagbuf,rt.fiDir,ADR(Dir),tagEnd));
  63.     END;
  64.     IF x>=0 THEN filereq^.leftOffset:=x; END;
  65.     IF y>=0 THEN filereq^.topOffset:=y; END;
  66.     IF (x>=0) OR (y>=0) THEN filereq^.reqPos:=rt.ReqPosTopLeftScr; END;
  67.     IF rt.FileRequest (filereq, ADR(File),ADR(Title),
  68.                 TAG(tagbuf,rt.Window,Window,rt.WaitPointer,TRUE,tagEnd)) THEN
  69.       Dir:=str110Ptr(filereq^.dir)^;
  70.       IF (Length(Dir)>0) AND (Dir[Length(Dir)-1]#':') THEN
  71.         Concat(Dir,'/');
  72.       END;
  73.       Concat(Dir,File);
  74.       Copy(FName,Dir);
  75.       RETURN TRUE
  76.     ELSE
  77.       RETURN FALSE;
  78.     END;
  79.     rt.FreeRequest (filereq);
  80.   ELSE
  81.     RETURN FALSE;
  82.   END;
  83. END FileReq;
  84.  
  85. END ReqTFileReq.mod
  86.