home *** CD-ROM | disk | FTP | other *** search
/ World of A1200 / World_Of_A1200.iso / programs / emulator / appleonamiga / txt / acaslreq.mod < prev    next >
Text File  |  1995-02-27  |  3KB  |  156 lines
  1. IMPLEMENTATION MODULE ACASLReq;
  2.  
  3. (*$ LargeVars:=FALSE *)
  4. FROM SYSTEM    IMPORT    ADR, ADDRESS,TAG,CAST;
  5. FROM UtilityD    IMPORT    tagEnd,tagIgnore;
  6. FROM String    IMPORT    Copy, LastPos, Length, Concat;
  7. IMPORT d:AslD, l:AslL, DosD,DosL, ID:IntuitionD, A:Arts;
  8.  
  9. VAR
  10.   (*$ LongAlign:=TRUE *)
  11.   r:d.FileRequesterPtr;
  12.   buff:ARRAY[0..20] OF LONGINT;
  13.   File, Dir: ARRAY[0..127] OF CHAR;
  14.  
  15.  
  16. (*$ RangeChk:=FALSE StackChk:=FALSE OverflowChk:=FALSE StackParms:=FALSE
  17.     Volatile:=FALSE
  18.  *)
  19.  
  20. (* Zerlege f in file und dir *)
  21. PROCEDURE GetPath(VAR f,d:ARRAY OF CHAR);
  22. VAR pos,i:INTEGER;
  23. BEGIN
  24.   Copy(d,f);
  25.   pos:=LastPos(f,-1,'/');
  26.   IF pos<0 THEN
  27.     pos:=LastPos(f,-1,':');
  28.   END;
  29.   IF pos>=0 THEN
  30.     IF d[pos]=':' THEN d[pos+1]:=0C ELSE d[pos]:=0C END;
  31.     INC(pos);
  32.     FOR i:=pos TO Length(f) DO
  33.       f[i-pos]:=f[i]
  34.     END;
  35.     f[i]:=0C;
  36.   ELSE
  37.     d[0]:=0C
  38.   END;
  39. END GetPath;
  40.  
  41.  
  42. (*$ CopyDyn:=FALSE *)
  43. PROCEDURE FileReq(
  44.         VAR FName:ARRAY OF CHAR;
  45.         Title,
  46.         Ext:ARRAY OF CHAR;
  47.         save:BOOLEAN
  48.         ):BOOLEAN;
  49. VAR
  50.   flags:d.FileReqFlagSet;
  51.   ok:BOOLEAN;
  52.   window:ID.WindowPtr;
  53.   pat:LONGCARD;
  54. BEGIN
  55.   IF Ext[0]=0C THEN
  56.     pat:=tagIgnore
  57.   ELSE
  58.     pat:=ORD(d.aslPattern)
  59.   END;
  60.   window:=CAST(DosD.ProcessPtr,A.thisTask)^.windowPtr;
  61.   IF CAST(LONGINT,window)<0 THEN
  62.     RETURN FALSE
  63.   END;
  64.   Copy(File,FName);
  65.   GetPath(File,Dir);
  66.   IF (window#NIL)&(window^.userPort#NIL) THEN
  67.     flags:=d.FileReqFlagSet{d.filNewIDCMP}
  68.   ELSE
  69.     flags:=d.FileReqFlagSet{}
  70.   END;
  71.   IF save THEN
  72.     flags:=flags+d.FileReqFlagSet{d.filPatGad,d.filSave}
  73.   ELSE
  74.     flags:=flags+d.FileReqFlagSet{d.filPatGad}
  75.   END;
  76.   IF r=NIL THEN
  77.     r:=l.AllocAslRequest(d.aslFileRequest,TAG(buff,
  78.       d.aslPattern,    ADR('#?'),
  79.       d.aslHeight,    200,
  80.       tagEnd));
  81.   END;
  82.   IF r#NIL THEN
  83.       ok:=l.AslRequest(r,TAG(buff,
  84.             d.aslHail,        ADR(Title),
  85.         d.aslWindow,    window,
  86.         pat,        ADR(Ext),
  87.         d.aslDir,        ADR(Dir),
  88.         d.aslFile,        ADR(File),
  89.         d.aslFuncFlags,    flags,
  90.         d.aslExtFlags1,    d.Fil1FlagSet{},
  91.         tagEnd));
  92.   ELSE
  93.     ok:=FALSE;
  94.   END;
  95.   IF ok THEN
  96.     Copy(FName,r^.dir^);
  97.     IF ~DosL.AddPart(ADR(FName),r^.file,HIGH(FName)+1) THEN
  98.       ok:=FALSE
  99.     END;
  100.   END;
  101.   RETURN ok;
  102. END FileReq;
  103.  
  104. (*$ CopyDyn:=FALSE *)
  105. PROCEDURE DirReq(
  106.         VAR DName:ARRAY OF CHAR;
  107.         Title:ARRAY OF CHAR
  108.         ):BOOLEAN;
  109. VAR
  110.   flags:d.FileReqFlagSet;
  111.   ok:BOOLEAN;
  112.   window:ID.WindowPtr;
  113. BEGIN
  114.   window:=CAST(DosD.ProcessPtr,A.thisTask)^.windowPtr;
  115.   IF CAST(LONGINT,window)<0 THEN
  116.     RETURN FALSE
  117.   END;
  118.   IF (window#NIL)&(window^.userPort#NIL) THEN
  119.     flags:=d.FileReqFlagSet{d.filNewIDCMP}
  120.   ELSE
  121.     flags:=d.FileReqFlagSet{}
  122.   END;
  123.   IF r=NIL THEN
  124.     r:=l.AllocAslRequest(d.aslFileRequest,TAG(buff,
  125.       d.aslPattern,    ADR('#?'),
  126.       tagEnd));
  127.   END;
  128.   IF r#NIL THEN
  129.       ok:=l.AslRequest(r,TAG(buff,
  130.             d.aslHail,        ADR(Title),
  131.         d.aslWindow,    window,
  132.         d.aslDir,        ADR(DName),
  133.         d.aslFuncFlags,    flags,
  134.         d.aslExtFlags1,    d.Fil1FlagSet{d.fil1NoFiles},
  135.         tagEnd));
  136.   ELSE
  137.     ok:=FALSE;
  138.   END;
  139.   IF ok THEN
  140.     Copy(DName,r^.dir^);
  141.   END;
  142.   RETURN ok;
  143. END DirReq;
  144.  
  145.  
  146. PROCEDURE FreeReq;
  147. BEGIN
  148.   IF r#NIL THEN l.FreeAslRequest(r); r:=NIL END;
  149. END FreeReq;
  150.  
  151. BEGIN
  152.   r:=NIL;
  153. CLOSE
  154.   FreeReq;
  155. END ACASLReq.
  156.