(* ------------------------------------------------------------------------
  :Program.       AppPrint V1.07
  :Contents.      Adds an AppIcon to Workbench for printing files
  :Author.        Stefan Hellwig
  :Address.       Oberer Kirchweg 12
  :Address.       3501 Schauenburg 1
  :Address.       Federal Republic of Germany
  :EMail.         Z-Netz : STEFAN_HELLWIG@URANUS.ZER
  :EMail.         UseNet : stefan_hellwig@uranus.zer.sub.org
  :History.       v1.00 25-Feb-92 Simply prints files. Doubleclick quits.
  :History.       v1.01 26-Feb-92 Prefs window opens on doubleclick.
  :History.       v1.02 27-Feb-92 Prefs window uses RenderInfo [kai] to
                                  set window/gadget-dimensions and font.
  :History.       v1.03 27-Feb-92 Looks for given tooltypes and uses them.
  :History.       v1.04 28-Feb-92 If CLI-started uses given arguments.
  :History.       v1.05 29-Feb-92 Minor enhancements & usage of System().
  :History.       v1.06 03-Mar-92 AppMenuItem added.
  :History.       v1.07 18-Mar-92 Bugfixes. First public release.
  :Copyright.     (c) 1992 by Stefan Hellwig. Public Domain.
  :Copyright.     For non-commercial use only !
  :Language.      Oberon
  :Translator.    AMIGA OBERON v2.13d
  :Remark.        Uses RenderInfo (Kai Bolay [kai]) to adjust on WB-Screen.
  :Remark.        Needs TYPE command for printing.
  ------------------------------------------------------------------------ *)

MODULE AppPrint;

IMPORT
     ICON : Icon,
     E    : Exec,
     D    : Dos,
     RQ   : Requests,
     GT   : GadTools,
     G    : Graphics,
     I    : Intuition,
     U    : Utility,
     STR  : Strings2,      (* Strings V1.1 (18-Okt-91) F.Siebert/H.Goebel *)
     S    : SYSTEM,
     OL   : OberonLib,
     RI   : RenderInfo,    (* RenderInfo [kai] AMOK-Disk # 57 *)
     WB   : Workbench;

CONST
     appName = "Print";                  (* Name des AppIcons    *)
     appMenuText = "AppPrint";           (* Text fuer Tools-Menu *)

     (* String-Teile fuer D.System() *)

     copyString = "TYPE ";
     prtString = " >PRT:";
     hexString = " HEX";
     numString = " NUMBER";

     ON = 1;
     OFF = 0;
     onStr = "ON";
     offStr = "OFF";
     WindowTitle = "AppPrint V1.07";

     (* Benutzte ToolTypes *)

     iconTool = "ICON";
     hexTool = "HEX";
     numTool = "NUM";

     (* CLI/Shell-Argument-String und Indizes fuer ReadArgs *)

     CLIargs = "ICON/A,HEX/S,NUM/S";
     iconIdx = 0;
     hexIdx = 1;
     numIdx = 2;
     numArgs = 3; (* Gesamtzahl der (Shell-)Argumente *)

VAR
     DiskObjPtr : WB.DiskObjectPtr;
     MyLock     : D.FileLockPtr;     (* Lock auf mich      *)
     MyName     : E.STRPTR;          (* Mein Programm-Name *)
     MyDiskObj  : WB.DiskObjectPtr;
     AppMsgPort : E.MsgPortPtr;
     AppIconPtr : WB.AppIconPtr;
     AppMenuPtr : WB.AppMenuItemPtr;
     AppMsgPtr  : WB.AppMessagePtr;
     AppMessage : WB.AppMessage;
     MainLock   : D.FileLockPtr;
     OldLock    : D.FileLockPtr;
     WBStartMsg : WB.WBStartupPtr;
     AppIconName: E.STRPTR;
     HexValue   : E.STRPTR;
     NumValue   : E.STRPTR;
     MyReadArgs : D.RDArgsPtr;       (* Shell-Arguments *)

     FileName   : E.STRING;
     Command    : E.STRPTR;
     Hex, Num   : INTEGER;
     verString  : ARRAY 80 OF CHAR;

     (* Vars fuer Window & Gadgets *)

     RenInfo: RI.RenderInfoPtr;
     nw     : I.NewWindow;
     ng     : GT.NewGadget;
     WinPtr : I.WindowPtr;
     scr    : I.ScreenPtr;
     VI     : GT.VisualInfo;
     mygad  : I.GadgetPtr;
     Context: I.GadgetPtr;
     GList  : I.GadgetPtr;

(* ---------------------------- *)

PROCEDURE ErrorRequest(ErrMsg: ARRAY OF CHAR);
(* $CopyArrays- *)
VAR
     Easy : I.EasyStruct;

BEGIN
     Easy.structSize := SIZE(Easy);
     Easy.flags := LONGSET{};
     Easy.title := S.ADR("AppPrint Message");
     Easy.textFormat := S.ADR("Error : %s");
     Easy.gadgetFormat := S.ADR("Cancel");
     LOOP
          IF I.EasyRequest(NIL, S.ADR(Easy), NIL, S.ADR(ErrMsg))=0 THEN
                EXIT;
          END;
     END;
END ErrorRequest;

(* --------- Alternativ-Routine zu o.g. ErrorRequest() -----------

PROCEDURE ErrorRequest(ErrMsg: ARRAY OF CHAR);
(* $CopyArrays- *)
BEGIN
     IF RQ.Request("AppPrint:", ErrMsg, "", "Cancel") THEN END;
END ErrorRequest;

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

PROCEDURE FreeThings;
BEGIN
     IF GList # NIL THEN GT.FreeGadgets(GList) END;
     IF WinPtr # NIL THEN I.CloseWindow(WinPtr) END;
     IF VI # NIL THEN GT.FreeVisualInfo(VI) END;
     IF scr # NIL THEN I.UnlockPubScreen(NIL,scr) END;
     IF RenInfo # NIL THEN RI.CleanUpRenderInfo(RenInfo) END;
     GList := NIL;
     Context := NIL;
     WinPtr := NIL;
     VI := NIL;
     scr := NIL;
     RenInfo := NIL;
END FreeThings;

(* ---------------------------- *)

PROCEDURE PopUpWindow;
VAR
     WinWidth, WinHeight : INTEGER;
     GadHeight           : INTEGER;
BEGIN
     scr  := I.LockPubScreen("Workbench");
     RQ.Assert(scr#NIL,"Workbench is not open !");

     (* RenderInfo des Screens *)

     RenInfo := RI.GetRenderInfo(scr);
     VI := GT.GetVisualInfo(scr, U.done);

     (* Erstellen der Gadgets und eines Visitor-Windows *);

     IF RenInfo.fontSize > 0 THEN
          WinWidth := 14*RenInfo.fontSize+150; (* LEN(WindowTitle) = 14 *)
          GadHeight := RenInfo.fontSize + 6;
     ELSE
          WinWidth := 300;
          GadHeight := 12;
     END;

     GList   := NIL;
     Context := GT.CreateContext(GList);  (* Brauche ich für FirstGadget *)
     RQ.Assert(Context#NIL,"Context-Gadget not created !");

     ng.leftEdge    := 10;
     ng.topEdge     := scr.wBorTop + RenInfo.fontSize + 10;
     ng.width       := 0;
     ng.height      := GadHeight;
     ng.gadgetText  := S.ADR("Hexadecimal");
     ng.textAttr    := scr.font;
     ng.gadgetID    := 0;
     ng.flags       := LONGSET{GT.placeTextRight};
     ng.visualInfo  := VI;
     ng.userData    := NIL;

     mygad := GT.CreateGadget(GT.checkBoxKind, Context, ng,
                              GT.cbChecked, Hex,
                              U.done);

     RQ.Assert(mygad#NIL,"Hex-Gadget not created !");

     INC(WinHeight, ng.topEdge+ng.height);

     ng.topEdge     := ng.topEdge+ng.height+5;
  (* ng.width       := 0; *)
     ng.height      := GadHeight;
     ng.gadgetText  := S.ADR("Number");
  (* ng.textAttr    := scr.font; wie immer *)
     ng.gadgetID    := 1;
  (* ng.flags       := LONGSET{GT.placeTextRight}; wie vorher auch *)

     mygad := GT.CreateGadget(GT.checkBoxKind, mygad, ng,
                              GT.cbChecked, Num,
                              U.done);

     RQ.Assert(mygad#NIL,"Num-Gadget not created !");

     INC(WinHeight, ng.height);

     ng.topEdge     := ng.topEdge+ng.height+10;
     ng.width       := 8*RenInfo.fontSize+10;
     ng.height      := GadHeight;
     ng.gadgetText  := S.ADR("Continue");
  (* ng.textAttr    := scr.font; *)
     ng.gadgetID    := 2;
     ng.flags       := LONGSET{GT.placeTextIn};

     mygad := GT.CreateGadget(GT.buttonKind, mygad, ng,
                              U.done);

     RQ.Assert(mygad#NIL,"Quit-Gadget not created !");

     INC(WinHeight, ng.height);

     (* Beim naechsten Gadget waere ng.flags := gRelBottom/Left angebracht: *)

     ng.leftEdge    := WinWidth-ng.width-5; (* width wie oben *)
  (* ng.topEdge     := ng.topEdge; -> Wie vorheriges Gadget ! *)
     ng.height      := GadHeight;
     ng.gadgetText  := S.ADR("Quit");
  (* ng.textAttr    := scr.font; *)
     ng.gadgetID    := 3;
  (* ng.flags       := LONGSET{GT.placeTextIn}; wie vorher auch *)

     mygad := GT.CreateGadget(GT.buttonKind, mygad, ng,
                              U.done);

     RQ.Assert(mygad#NIL,"Continue-Gadget not created !");

     INC(WinHeight, ng.height-8);

     (* Window genau in die Mitte des Screens setzen.
        Hoehe je nach Gadget-Hoehe; Breite je nach Titel-Breite.
        AutoAdjust erlaubt. *)

     nw.leftEdge    := (RenInfo.screenWidth DIV 2)-(WinWidth DIV 2);
     nw.topEdge     := (RenInfo.screenHeight DIV 2)-(WinHeight DIV 2);
     nw.width       := WinWidth;
     nw.height      := WinHeight;
     nw.detailPen   := RenInfo.textPen;
     nw.blockPen    := RenInfo.backPen;
     nw.idcmpFlags  := LONGSET{I.gadgetUp, I.closeWindow};
     nw.flags       := LONGSET{I.windowDrag, I.windowDepth,
                               I.windowClose, I.activate};
     nw.firstGadget := NIL;
     nw.checkMark   := NIL;
     nw.title       := S.ADR(WindowTitle);
     nw.screen      := NIL;
     nw.bitMap      := NIL;
     nw.type        := SET{I.publicScreen};

     WinPtr := I.OpenWindowTags(nw,
                                I.waInnerHeight, nw.height,
                                I.waInnerWidth, nw.width,
                                I.waAutoAdjust, I.LTRUE,
                                U.done);

     RQ.Assert(WinPtr#NIL, "Open Window failed !");

     (* Erzeugte Gadgets an das Window hängen *)

     IF I.AddGList(WinPtr, GList, -1, -1, NIL)=0 THEN END;
     I.RefreshGList(GList, WinPtr, NIL, -1);

     (* RefreshWindow für korrekte Darstellung der Gadgets *)

     GT.RefreshWindow(WinPtr, NIL);

END PopUpWindow;

(* ----------------------------------------------------- *)
(* Behandlung der Intuition-Messages an dem Prefs-Window *)
(* ----------------------------------------------------- *)

PROCEDURE HandleIDCMP(win : I.WindowPtr):BOOLEAN;
VAR
     IntuiMsgPtr    : I.IntuiMessagePtr;
     IntuiMsg       : I.IntuiMessage;
     TmpGadPtr      : I.GadgetPtr;
BEGIN
     LOOP
          REPEAT
               E.WaitPort(win^.userPort);
               IntuiMsgPtr := GT.GetIMsg(win^.userPort)
          UNTIL IntuiMsgPtr#NIL;
          IntuiMsg := IntuiMsgPtr^;
          GT.ReplyIMsg(IntuiMsgPtr);

          TmpGadPtr := IntuiMsg.iAddress;

          IF (I.gadgetUp IN IntuiMsg.class) THEN
               CASE TmpGadPtr^.gadgetID OF
                    0: IF Hex=ON THEN
                            Hex := OFF;
                       ELSE
                            Hex := ON;
                       END;
                  | 1: IF Num=ON THEN
                            Num := OFF;
                       ELSE
                            Num := ON;
                       END;
                  | 2: FreeThings;
                       RETURN TRUE;   (* -> Continue *)
                  | 3: RETURN FALSE;  (* -> Quit (FreeThings kommt später) *)
               END;
          ELSE
               FreeThings;
               RETURN TRUE;           (* -> Close-Gadget = Continue *)
          END;
     END;
END HandleIDCMP;

(* ------------------------------------------------------- *)
(* Argumente oder ToolTypes auswerten und DiskObject holen *)
(* ------------------------------------------------------- *)

PROCEDURE Get;
VAR
     TmpArgsPtr  : D.RDArgsPtr;
     ResultArray : ARRAY numArgs OF LONGINT;
     Result      : LONGINT;
BEGIN
     (* Wurde ich von der Workbench gestartet ? *)

     IF OL.wbStarted THEN
          WBStartMsg := S.VAL(WB.WBStartupPtr, OL.wbenchMsg);

          IF WBStartMsg#NIL THEN
               MyName := WBStartMsg.argList[0].name;
               MyLock := WBStartMsg.argList[0].lock;
               MyLock := D.CurrentDir(MyLock);
          ELSE
               ErrorRequest("No WB-Startup-Message !");
               HALT(20);
          END;

          (* --- Hole Dir das DiskObject des Programmes --- *)

          MyDiskObj := ICON.GetDiskObject(MyName^);
          RQ.Assert(MyDiskObj#NIL, "No AppPrint-Icon !");

          (* --- Setze wieder das alte Directory --- *)

          MyLock := D.CurrentDir(MyLock);

          (* --- Auswertung der ToolTypes --- *)

          HexValue := ICON.FindToolType(MyDiskObj.toolTypes, hexTool);
          NumValue := ICON.FindToolType(MyDiskObj.toolTypes, numTool);

          IF HexValue#NIL THEN
               IF HexValue^=onStr THEN Hex := ON END;
               IF HexValue^=offStr THEN Hex := OFF END;
          ELSE
               Hex := OFF;
          END;

          IF NumValue#NIL THEN
               IF NumValue^=onStr THEN Num := ON END;
               IF NumValue^=offStr THEN Num := OFF END;
          ELSE
               Num := OFF;
          END;

          AppIconName := ICON.FindToolType(MyDiskObj.toolTypes, iconTool);

          (* Wurde ein Alternativ-Icon angegeben ? Dann benutze es ! *)

          IF AppIconName#NIL THEN
               DiskObjPtr := ICON.GetDiskObject(AppIconName^);
               RQ.Assert(DiskObjPtr#NIL, "Can't load given Icon !");
          ELSE
               DiskObjPtr := MyDiskObj;
          END;

     ELSE           (* --- Shell-Start --- *)

          MyReadArgs := D.AllocDosObject(D.rdArgs, NIL);
          RQ.Assert(MyReadArgs#NIL, "Can't get RDArgs !");

          TmpArgsPtr := MyReadArgs;

          MyReadArgs := D.ReadArgs(CLIargs, ResultArray, MyReadArgs);
          IF MyReadArgs = NIL THEN
               Result := D.VPrintf("AppPrint: Required argument missing.\n",
                                    NIL);
               D.FreeDosObject(D.rdArgs, TmpArgsPtr);
               HALT(5);
          ELSE
               IF ResultArray[iconIdx]#NIL THEN
                    AppIconName := S.VAL(E.STRPTR, ResultArray[iconIdx]);
               END;
               IF ResultArray[hexIdx]=D.DOSTRUE THEN Hex := ON END;
               IF ResultArray[numIdx]=D.DOSTRUE THEN Num := ON END;
               DiskObjPtr := ICON.GetDiskObject(AppIconName^);
               IF DiskObjPtr=NIL THEN
                    ErrorRequest("Can't load icon !");
                    HALT(5);
               ELSE
                    D.FreeArgs(MyReadArgs);
                    D.FreeDosObject(D.rdArgs, MyReadArgs);
                    MyReadArgs := NIL;
               END;
          END;
     END;
     DiskObjPtr.currentX := WB.noIconPosition;
     DiskObjPtr.currentY := WB.noIconPosition;
END Get;

(* -------------------------------------------- *)
(* Behandlung der AppMessages von der Workbench *)
(* -------------------------------------------- *)
PROCEDURE ProcessMsg() : BOOLEAN;
VAR
     Counter : INTEGER;
     SysRes  : LONGINT;

     PROCEDURE ReturnClear;
     BEGIN
          IF MainLock # NIL THEN OldLock := D.CurrentDir(MainLock) END;
          IF AppMsgPtr # NIL THEN E.ReplyMsg(AppMsgPtr) END;
     END ReturnClear;

BEGIN
     REPEAT UNTIL E.Wait(LONGSET{AppMsgPort.sigBit})#LONGSET{};
     AppMsgPtr := E.GetMsg(AppMsgPort);
     IF AppMsgPtr = NIL THEN RETURN TRUE END;

     AppMessage := AppMsgPtr^;  (* dann wird es etwas "uebersichtlicher" *)

     IF (AppMessage.numArgs = 0) OR (AppMessage.type = WB.appMenuItem) THEN
          E.ReplyMsg(AppMsgPtr);
          RETURN FALSE;
     END;
     IF AppMessage.type = WB.appIcon THEN
          Counter := 0;
          WHILE (Counter < AppMessage.numArgs) DO
               IF Counter = 0 THEN
                    MainLock := D.CurrentDir(AppMessage.argList[Counter].lock);
               ELSE
                    OldLock := D.CurrentDir(AppMessage.argList[Counter].lock);
               END;
               FileName := AppMessage.argList[Counter].name^;
               IF FileName = "" THEN
                    ReturnClear;
                    ErrorRequest("Wrong file-type moved on AppIcon !");
                    RETURN TRUE;
               END;
               NEW(Command);
               IF Command=NIL THEN
                    ReturnClear;
                    RETURN TRUE;
               END;
               Command^ := copyString;
               STR.Append(Command^, FileName);
               STR.Append(Command^, prtString);
               IF (Hex=OFF) AND (Num=ON) THEN
                    STR.Append(Command^, numString);
               END;
               IF (Hex=ON) THEN STR.Append(Command^, hexString) END;

               SysRes := D.SystemTags(Command^,
                                      D.sysAsynch, D.DOSFALSE,
                                      U.done);
               IF SysRes = -1 THEN
                    ErrorRequest("System() failed !");
               END;

               DISPOSE(Command);
               INC(Counter);
          END;
     END;

     (* Message endlich zurückgeben und CD auf den ersten (Start-) Lock *)
     (* Hier könnte es zu Problemen kommen, wegen spaetem Reply() !     *)

     ReturnClear;
     RETURN TRUE;
END ProcessMsg;

(* -------------------------------------------------------------- *)
(* Anhaengen des AppIcons und eines AppMenuItems ins ToolMenu.    *)
(* Danach kommt eine Endlos-Schleife bis QUIT gewaehlt wurde.     *)
(* -------------------------------------------------------------- *)

PROCEDURE CreateAppIcon;
BEGIN
     AppMsgPort := E.CreateMsgPort();
     IF AppMsgPort # NIL THEN
          AppIconPtr := WB.AddAppIcon(0, NIL, appName, AppMsgPort,
                                      NIL, DiskObjPtr, U.done);
          RQ.Assert(AppIconPtr#NIL, "No AppIcon created ! WB started ?");
          AppMenuPtr := WB.AddAppMenuItem(0, NIL, appMenuText, AppMsgPort,
                                          U.done);
          RQ.Assert(AppMenuPtr#NIL, "No AppMenu created ! WB started ?");
          LOOP
               REPEAT
               UNTIL NOT ProcessMsg(); (* Nur bei Doppelklick FALSE *)

               PopUpWindow;
               IF NOT HandleIDCMP(WinPtr) THEN EXIT END;
          END;
     END;
END CreateAppIcon;

(* -----------------------------++++ MAIN ++++---------------------------- *)

BEGIN
     (* Sicherheits-Check: Laufe ich unter Kick 37 oder hoeher ? *)

     RQ.Assert(E.exec.libNode.version>36, "Use OS Version 37 or above !");

     (* Version-String fuer den Shell-Befehl VERSION *)

     verString := "$VER: AppPrint V1.07 (18.03.92) by Stefan Hellwig\r\n";

     (* Einige zusaetzliche Absicherungen: *)

     RQ.Assert(WB.base#NIL, "Workbench.Library V37 required !");
     RQ.Assert(U.base#NIL, "Utility.Library V37 required !");
     RQ.Assert(ICON.base.version>=36, "Icon.Library V36 required !");

     (* Standardeinstellung setzen *)

     Hex := OFF;
     Num := OFF;

     Get;
     CreateAppIcon;

CLOSE

     FreeThings;
     IF MyReadArgs # NIL THEN
          D.FreeArgs(MyReadArgs);
          D.FreeDosObject(D.rdArgs, MyReadArgs);
     END;
     IF MyDiskObj # NIL THEN ICON.FreeDiskObject(MyDiskObj) END;
     IF (DiskObjPtr # MyDiskObj) AND (DiskObjPtr # NIL) THEN
          ICON.FreeDiskObject(DiskObjPtr);
     END;
     IF AppMsgPort # NIL THEN E.DeleteMsgPort(AppMsgPort) END;
     IF AppIconPtr # NIL THEN
          IF WB.RemoveAppIcon(AppIconPtr) THEN END;
     END;
     IF AppMenuPtr # NIL THEN
          IF WB.RemoveAppMenuItem(AppMenuPtr) THEN END;
     END;

END AppPrint.