(* ----------------------------------------------------------------------------

:Program.       FileRexx.mod
:Contents.      Filerequester-Program with ARexx-Port in order to replace e.g.
:Contents.      the ugly, non-standard TurboText-Filerequester
:Author.        Michael 'Mick' Hohmann
:Address.       Carl-Schilling-Str. 10, 8701 Kirchheim, Germany
:Phone.         09 31 / 35 31 54 - 0
:Copyright.     Freely Distributable
:Language.      Oberon
:Translator.    AmigaOberon v3.01d
:Support.       Rexx-Part from hartmut Goebel
:Imports.       MoreIntuition [mick], MoreStrings [hG], SimpleRexx [hG]
:History.       v0.1 [mick] Aug-92 first Version
:History.       v1.2 [hG] Apr-93 some REXX-Bugfixes
:History.       v1.2a [mick,fbs,kai] Apr-93 Added FilePart/PathPart and
                      MakeFJRTag
:History.       v1.3 [mick,kai,fbs,hG] Mai-93 Finally got the Top/Left-Pos
                      working

---------------------------------------------------------------------------- *)

MODULE FileRexx;

IMPORT
  NoGuru,            (** nach Beendigung der BETA-Phase entfernen **)
  ASL,
  BasicTypes,
  D:=Dos,
  E:=Exec,
  G:=Graphics,
  I:=Intuition,
  MI:=MoreIntuition,
  MS:=MoreStrings,
  OL:=OberonLib,
  RX:=Rexx,
  RXS:=RexxSysLib,
  RVI,
  Requests,
  SR:=SimpleRexx,
  Strings,
  SYSTEM,
  Utility;

CONST
  strLen             = 80;
  argTemplate        = "FILE,PAT=PATTERN/K,TITLE/K,TOP/K/N,LEFT/K/N,WIDTH/K/N,HEIGHT/K/N,"
                       "PS=PUBSCREEN/K,ENVVAR/K,LOCAL/S,SM=SAVEMODE/S,DRAWERSONLY/S,"
                       "RX=REXXHOST/S,PORTNAME/K,HELP/S";
  rxTemplate         = "FILE,PAT=PATTERN/K,TITLE/K,TOP/K/N,LEFT/K/N,WIDTH/K/N,HEIGHT/K/N,"
                       "PS=PUBSCREEN/K,VAR/K";
  oProgName          = "FileRexx";
  version            = " 1.3";
  date               = " (16.5.93)";
  versionString      = "$VER: FileRexx 1.3 (16.5.93)";
  need20             = "This programm needs at least Kick 2.04!";
  leererString       = "";

TYPE
  PubString          = ARRAY I.maxPubScreenName+1 OF CHAR;
  DosArgs            = STRUCT
                         file      : E.STRPTR;
                         pattern   : E.STRPTR;
                         title     : E.STRPTR;
                         top       : UNTRACED POINTER TO LONGINT;
                         left      : UNTRACED POINTER TO LONGINT;
                         width     : UNTRACED POINTER TO LONGINT;
                         height    : UNTRACED POINTER TO LONGINT;
                         pubScreen : E.STRPTR;
                         envVar    : E.STRPTR;
                         local     : LONGINT;
                         saveMode  : LONGINT;
                         dirOnly   : LONGINT;
                         rexxHost  : LONGINT;
                         portName  : E.STRPTR;
                         help      : LONGINT
                       END;


VAR
  dArgs,rArgs        : DosArgs;
  pubScrName         : PubString;
  activeScreen       : I.ScreenPtr;
  reqWindow          : I.WindowPtr;
  aslReq             : ASL.FileRequesterPtr;
  reqWidth,reqHeight : LONGINT;
  top,left           : LONGINT;
  width,height       : LONGINT;
  rxHost             : SR.RexxHost;
  progName           : E.STRING;
  progNamePtr        : E.STRPTR;
  sMsg               : RX.RexxMsgPtr;
  hisPort            : E.MsgPortPtr;
  useRexx            : BOOLEAN; (* !!! *)

(*****************************************************************************)

PROCEDURE MakeFJRTag(tag: LONGINT; data: SYSTEM.ADDRESS):LONGINT;

BEGIN

  IF data = NIL THEN
    RETURN Utility.ignore
  ELSE
    RETURN tag
  END

END MakeFJRTag;

(*****************************************************************************)

PROCEDURE CleanUp(); (** Alle Locks werden wieder freigegeben **)

BEGIN

  IF activeScreen#NIL THEN
    I.UnlockPubScreen(NIL,activeScreen);
    activeScreen:=NIL
  END;

  IF reqWindow#NIL THEN
    I.CloseWindow(reqWindow);   (** Window wieder schliessen **)
    reqWindow:=NIL
  END;

END CleanUp;

(*****************************************************************************)


(** Setzt die Option und öffnet dann den ASL-Req **)
PROCEDURE OpenReq(pArgs : DosArgs; VAR outBuffer: ARRAY OF CHAR);

VAR
  screenRect         : G.Rectangle;
  screenModeID       : LONGINT;
  aslFlags           : LONGSET;
  aslExtFlags        : LONGSET;
  buffer             : E.STRING;
  fileNamePtr        : E.STRPTR;
  pathNamePtr        : E.STRPTR;
  backupChar         : CHAR;
  fileName,pathName  : E.STRING;
  viewPortExtra      : G.ViewPortExtra;

BEGIN

  aslFlags:=LONGSET{};
  aslExtFlags:=LONGSET{};

  fileNamePtr:=D.FilePart(pArgs.file^);
  COPY(fileNamePtr^,fileName);
  pathNamePtr:=D.PathPart(pArgs.file^);
  backupChar:=pathNamePtr^[0];
  pathNamePtr^[0]:=0X;
  COPY(pArgs.file^,pathName);
  progNamePtr^[0]:=backupChar;

  IF pArgs.saveMode#D.DOSFALSE THEN
    INCL(aslFlags,ASL.save);
  END; (* IF *)

  IF pArgs.dirOnly#D.DOSFALSE THEN
    INCL(aslExtFlags,ASL.drawersOnly);
  END; (* IF *)

  IF pArgs.pattern#SYSTEM.ADR(leererString) THEN
    INCL(aslFlags,ASL.patGad);
    IF pArgs.dirOnly#D.DOSFALSE THEN
      INCL(aslExtFlags,ASL.filterDrawers);
    END; (* IF *)
  END; (* IF *)

  IF pArgs.pubScreen#NIL THEN
    COPY(pArgs.pubScreen^,pubScrName)
  END; (* IF *)
  activeScreen:=MI.LockFrontPubScr(pubScrName);   (** Den vordersten PubScreen, oder die WB locken **)

  IF (pArgs.width=NIL) OR (pArgs.height=NIL) OR (pArgs.top=NIL) OR (pArgs.left=NIL) THEN
(**
 **    IF NOT G.VideoControlTagList(activeScreen.viewPort.colorMap,G.vTagViewPortExtraGet,
 **                                 SYSTEM.ADR(viewPortExtra),Utility.done) THEN
 **      HALT (20)
 **    END; (* IF *)
 **)
    viewPortExtra:=activeScreen.viewPort.colorMap.vpe^;
    screenRect:=viewPortExtra.displayClip;

    IF pArgs.width=NIL THEN
      width:=screenRect.maxX - screenRect.minX + 1;
      width:=(width * 45) DIV 100;
      pArgs.width:=SYSTEM.ADR(width)
    END; (* IF *)

    IF pArgs.height=NIL THEN
      height:=screenRect.maxY - screenRect.minY + 1;
      height:=(height * 8) DIV 10;
      pArgs.height:=SYSTEM.ADR(height)
    END; (* IF *)

    IF pArgs.top=NIL THEN
      top:= - activeScreen.topEdge;
      IF top < 0 THEN top:=0 END;
      INC(top,(height DIV 10));
      pArgs.top:=SYSTEM.ADR(top)
    END; (* IF *)

    IF pArgs.left=NIL THEN
      left:= - activeScreen.leftEdge;
      IF left < 0 THEN left:=0 END;
      INC(left,(width DIV 10));
      pArgs.left:=SYSTEM.ADR(left)
    END; (* IF *)

  END; (* IF *)

  IF activeScreen=NIL THEN   (** Falls der vorderste Screen kein PubScreen, dann WB nach vorne **)
    IF I.WBenchToFront() THEN END
  END; (* IF *)

  reqWindow:=I.OpenWindowTagsA(NIL,I.waLeft,30,   (** WindowTags definieren und Window öffnen **)
                                   I.waTop,1,
                                   I.waWidth,1,
                                   I.waHeight,1,
                                   I.waBackdrop,E.true,
                                   I.waBorderless,E.true,
                                   I.waPubScreen,activeScreen,
                                   I.waPubScreenFallBack,E.true,Utility.done);

  Requests.Assert(reqWindow#NIL,"Sorry, couldn't open the window");

  IF ASL.AslRequestTags(aslReq,ASL.hail,pArgs.title,   (** ASL-Req allozieren und Tags definieren **)
                               ASL.window,reqWindow,
                               MakeFJRTag(ASL.leftEdge,pArgs.left),pArgs.left^,
                               MakeFJRTag(ASL.topEdge,pArgs.top),pArgs.top^,
                               MakeFJRTag(ASL.width,pArgs.width),pArgs.width^,
                               MakeFJRTag(ASL.height,pArgs.height),pArgs.height^,
                               MakeFJRTag(ASL.file,SYSTEM.ADR(fileName)),SYSTEM.ADR(fileName),
                               MakeFJRTag(ASL.dir,SYSTEM.ADR(pathName)),SYSTEM.ADR(pathName),
                               MakeFJRTag(ASL.pattern,pArgs.pattern),pArgs.pattern,
                               ASL.extFlags1,aslExtFlags,
                               ASL.funcFlags,aslFlags,Utility.done)#NIL THEN
    E.CopyMem(aslReq.dir^,buffer,MS.CLength(aslReq.dir));
    IF D.AddPart(buffer,aslReq.file^,SIZE(buffer)) THEN END;
    IF useRexx THEN (* !!! hG !!!  zusätzlich erst abfragen *)
      COPY(buffer,outBuffer);
    ELSE
      IF (pArgs.envVar # NIL) THEN
        IF pArgs.local # D.DOSFALSE THEN
          IF D.SetVar(pArgs.envVar^,buffer,LEN(buffer),LONGSET{D.localOnly}) THEN END;
        ELSE
          IF D.SetVar(pArgs.envVar^,buffer,LEN(buffer),LONGSET{D.globalOnly}) THEN END;
        END;
      ELSE
        D.PrintF("%s\n",SYSTEM.ADR(buffer))
      END
    END
  END; (* IF *)

  CleanUp

END OpenReq;

(*****************************************************************************)

PROCEDURE RexxLoop(); (** Abarbeitung der Rexx-Commands **)

VAR
  quit: BOOLEAN;
  rMsg: E.MessagePtr;
  mask  : LONGSET;


  PROCEDURE DoRxCommand(com: E.STRPTR); (** Berarbeitung der einzelnen Commandos **)

  VAR
   buf   : BasicTypes.DynString;
   argIn : D.RDArgsPtr;
   i     : INTEGER;
   rCom  : ARRAY 30 OF CHAR;
   fileBuffer: E.STRING;

  BEGIN

    i:=0;
    WHILE (com[i]#" ") & (com[i]#CHR(0)) DO
      rCom[i]:=CAP(com[i]);
      INC(i)
    END; (* WHILE *)

    rCom[i]:=CHR(0);

    IF rCom="QUIT" THEN
      quit:=TRUE;
      SR.ReplyRexxCommand(rMsg,0,0,NIL);
      RETURN
    END; (* IF *)

    WHILE (com[i]=" ") & (com[i]#CHR(0)) DO
      INC(i)
    END; (* WHILE *)

    buf:=MS.CopyCStringAdd(SYSTEM.ADR(com[i]),1);
    IF buf=NIL THEN
      SR.ReplyRexxCommand(rMsg,20,3,NIL);
      RETURN
    END;

    Strings.AppendChar(buf^,"\n");
    argIn:=D.AllocDosObject(D.rdArgs,NIL);
    IF argIn=NIL THEN
      SR.ReplyRexxCommand(rMsg,20,3,NIL);
      (* $IFNOT GarbageCollector *)
        DISPOSE(buf);
      (* $END *)
      RETURN
    END; (* IF *)

    rArgs:=dArgs;

    argIn.source.buffer:=SYSTEM.ADR(buf^);
    argIn.source.length:=Strings.Length(buf^);
    argIn.source.curChr:=0;
    argIn.flags:=LONGSET{D.noPrompt};

    IF D.ReadArgs(rxTemplate,rArgs,argIn)=NIL THEN
      SR.ReplyRexxCommand(rMsg,20,D.IoErr(),NIL);
    END; (* IF *)

    IF rCom="GETFILESAVE" THEN
      rArgs.saveMode:=D.DOSTRUE

    ELSIF rCom="GETDIR" THEN
      rArgs.dirOnly:=D.DOSTRUE

    ELSIF rCom#"GETFILE" THEN
      SR.ReplyRexxCommand(rMsg,10,11,NIL);
      (* $IFNOT GarbageCollector *)
        DISPOSE(buf);
      (* $END *)
      D.FreeDosObject(D.rdArgs,argIn);
      RETURN
    END; (* IF *)

    OpenReq(rArgs,fileBuffer);


    IF rArgs.envVar#NIL THEN
      IF RVI.SetRexxVar(rMsg,rArgs.envVar^,fileBuffer,Strings.Length(fileBuffer))=NIL THEN END;
      SR.ReplyRexxCommand(rMsg,0,NIL,NIL);
    ELSE
      SR.ReplyRexxCommand(rMsg,0,NIL,SYSTEM.ADR(fileBuffer));
    END; (* IF *)

  END DoRxCommand;


BEGIN

  REPEAT
    mask := E.Wait(LONGSET{rxHost.port.sigBit, D.ctrlC});
    IF rxHost.port.sigBit IN mask THEN
      rMsg := E.GetMsg(rxHost.port);

      IF RXS.IsRexxMsg(rMsg) THEN

        IF RX.ActionCode(rMsg(RX.RexxMsg).action) = RX.rxComm THEN
          DoRxCommand(rMsg(RX.RexxMsg).args[0]);
        ELSIF RX.ActionCode(rMsg(RX.RexxMsg).action) = RX.rxClose THEN
          quit := TRUE;
          E.ReplyMsg(rMsg);
        ELSE
          rMsg(RX.RexxMsg).result1:=10;
          rMsg(RX.RexxMsg).result2:=10;
          E.ReplyMsg(rMsg);
        END; (* IF *)

      ELSE
        E.ReplyMsg(rMsg);
      END; (* IF *)
    ELSIF D.ctrlC IN mask THEN
       quit := TRUE;
    END; (* IF *)
  UNTIL quit;

END RexxLoop;

(*****************************************************************************)

BEGIN
  (** Das Programm laeuft nur >= Kick 2.x **)
  IF OL.wbStarted THEN HALT(20); END;   (* sinnlos von WB *)
  IF D.dos.lib.version < 37 THEN
    IF D.Write(D.Output(),need20,SIZE(need20)) = 0 THEN END;
    HALT(20);
  END;
  SYSTEM.SETREG(0,SYSTEM.ADR(versionString));
  IF D.GetProgramName(progName,LEN(progName)) THEN
    progNamePtr:=D.FilePart(progName);
    COPY(progNamePtr^,progName)
  ELSE
    progName:=oProgName
  END;

  (** Initialisierung der Variablen **)
  dArgs:=DosArgs(SYSTEM.ADR(leererString),SYSTEM.ADR(leererString),
                 NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,0,0,0,NIL,0);
  top:=40; left:=40; width:=320; height:=380;
  pubScrName:="";

  (** Hole die Argumente von dem CLI **)
  IF D.ReadArgs(argTemplate,dArgs,NIL)=NIL THEN
    IF D.PrintFault(D.IoErr(),progName) THEN END;
    HALT(10)
  END; (* IF *)

  IF dArgs.help#0 THEN
    D.PrintF("\n\[33m%ls%s\[0m © 1993 by Michael 'Mick' Hohmann and Harmut Goebel"
             "%s\n\nOpens an ASL-FileRequester and returns the Result either"
             " to StdOut or\nto an Env-Variable. It is also possible to use"
             " it as an RexxHost with\nthe following commands:\n · GETFILE\n"
             " · GETFILESAVE\n · GETDIR\n · QUIT\nFor more help please take"
             " a look at the Manual!\n\n",SYSTEM.ADR(progName),SYSTEM.ADR(version),SYSTEM.ADR(date));
    HALT(0)
  END; (* IF *)

  aslReq:=ASL.AllocAslRequestTags(ASL.fileRequest,NIL);

  IF dArgs.rexxHost # NIL THEN
    rxHost.port:=E.CreateMsgPort();
    rxHost.port.node.pri:=0;

    IF dArgs.portName#NIL THEN
      rxHost.port.node.name:=dArgs.portName
    ELSE
      rxHost.port.node.name:=SYSTEM.ADR("FILEREXX")
    END; (* IF *)

    E.Forbid;

    hisPort:=E.FindPort(rxHost.port.node.name^);

    IF hisPort#NIL THEN
      sMsg:=RXS.CreateRexxMsg(rxHost.port,NIL,hisPort.node.name^);
      IF sMsg#NIL THEN
        sMsg.action:=RX.rxClose;
        sMsg.node.node.name := SYSTEM.ADR(RX.rxsDir);
        E.PutMsg(hisPort,sMsg);
        E.Permit;
      ELSE
        E.Permit;
        E.DeleteMsgPort(rxHost.port);
        HALT(20);
      END;
      D.PrintF("... Port already exists --- removing FileRexx\n\n");
      E.WaitPort(rxHost.port);
      RXS.DeleteRexxMsg(E.GetMsg(rxHost.port)); (* kann nur sMsg sein! *)
      E.DeleteMsgPort(rxHost.port);
      HALT(0);
    END;
    E.AddPort(rxHost.port);
    E.Permit;
    D.PrintF("Just opened an ARexx-Port ...\n"); (* !!! hG erst wenn auch geklpatt hat !!! *)
    useRexx := TRUE; (* !!! *)

    RexxLoop;

    E.RemPort(rxHost.port);
    LOOP
      sMsg := E.GetMsg(rxHost.port);
      IF sMsg = NIL THEN EXIT END;
      E.ReplyMsg(sMsg);
    END;
    E.DeleteMsgPort(rxHost.port);

  ELSE

   useRexx := FALSE;
   OpenReq(dArgs,progName);

  END; (* IF *)


CLOSE

  CleanUp;

  IF aslReq#NIL THEN
    ASL.FreeAslRequest(aslReq);   (** ASL-RequesterStruktur wieder freigeben **)
  END;

END FileRexx.