MODULE Modem;

(* **********************************************************************

        Modem Status Program By David Annett (c) 4 Dec 1988

        This program shows the logical state of the serial port's
        hardware lines.

********************************************************************** *)

(*$S-,$T-,$A+*)
   
FROM SYSTEM IMPORT
    CODE, ADR, SETREG, REGISTER, NULL, BYTE, ADDRESS;
FROM AMIGAX IMPORT
    CLinePtr, CLineLen, ExecBase;
FROM DOSLibrary IMPORT
    DOSName,  DOSBase, BPTR;
FROM DOSFiles IMPORT
    Open, Close, Write, CurrentDir, FileHandle, FileLock,
    ModeNewFile, ModeOldFile;
FROM DOSProcessHandler IMPORT
    Delay;
FROM DOSExtensions IMPORT
    ProcessPtr, FileHandleBlock;
FROM Libraries IMPORT
    OpenLibrary, CloseLibrary;
FROM Tasks IMPORT FindTask;
FROM Ports IMPORT
    GetMsg, ReplyMsg, WaitPort, MessagePtr, MsgPortPtr;
FROM Workbench IMPORT
    WBStartup, WBArgPtr;
FROM Interrupts IMPORT
    Forbid;
FROM Strings IMPORT
    Length;

FROM Exec IMPORT ExecName ;
FROM Strings IMPORT String ;
FROM Terminal IMPORT WriteString, WriteLn ;
FROM Intuition IMPORT Window, NewWindow, WindowPtr, IDCMPFlagSet, WindowFlagSet, WindowDrag, WindowDepth, WindowClose, GimmeZeroZero ;
FROM Intuition IMPORT ScreenFlagSet, WBenchScreen, IntuitionName, IntuitionBase, CloseWindowFlag, IntuiMessage ;
FROM Windows IMPORT OpenWindow, CloseWindow ;
FROM Pens IMPORT SetDrMd, Move, SetAPen, SetBPen ;
FROM Rasters IMPORT RastPortPtr, SetRast ;
FROM GraphicsLibrary IMPORT GraphicsBase, GraphicsName, DrawingModeSet, Jam2 ;
FROM Text IMPORT Text, SetFont, OpenFont, TextAttr, TextFontPtr, CloseFont, FontStyleSet, FontFlagSet ;
FROM CIAHardware IMPORT CIAType, CIAComDTR, CIAComDSR, CIAComRTS, CIAComCTS, CIAComCD ;
    
  CONST
    wName = "RAW:100/50/200/100/Arguments";
    
  VAR
    myProcess: ProcessPtr;
    WBenchMsg: POINTER TO WBStartup;
    name: POINTER TO ARRAY [0..32767] OF CHAR;
    args: WBArgPtr;
    i: LONGINT;
    LF: CARDINAL;
    tool: FileHandle;
    oldLock: FileLock;
    fh: POINTER TO FileHandleBlock;
    
PROCEDURE ShowModem;

VAR MyWindow : NewWindow ;
    MyWindowPtr : WindowPtr ;
    WindowName : String ;
    MyScreenName : String ;
    TextName : String;
    Finish : BOOLEAN ;
    MyRastPortPtr : RastPortPtr ;
    CIAB[0BFD000H] : CIAType ;
    MyMessagePtr : MessagePtr ;
    MyMsgPortPtr : MsgPortPtr ;
    MyTextAttr : TextAttr ;
    MyTextFontPtr : TextFontPtr ;    

BEGIN
  WindowName := 'Modem Status' ;
  MyScreenName := 'Modem Status by David Annett  3 Sutherland Ave  Upper Hutt  New Zealand' ;
  TextName := 'topaz.font';

  IntuitionBase := OpenLibrary (IntuitionName,0) ;
  IF IntuitionBase <> 0 THEN
      ExecBase := OpenLibrary (ExecName,0) ;
      IF ExecBase <> 0 THEN
        GraphicsBase := OpenLibrary (GraphicsName,0) ;
        IF GraphicsBase <> 0 THEN
          WITH MyWindow DO
            LeftEdge :=180 ;
            TopEdge := 20 ;
            Width := 208 ;
            Height :=20 ;
            DetailPen := BYTE (0) ;
            BlockPen := BYTE (1) ;
            IDCMPFlags := IDCMPFlagSet{CloseWindowFlag} ;
            Flags := WindowFlagSet {WindowDrag, WindowDepth, WindowClose,
                                    GimmeZeroZero } ;
            FirstGadget := NULL ;
            CheckMark := NULL ;
            Title := ADR (WindowName) ;
            Type := ScreenFlagSet{WBenchScreen} ;
          END ; (* WITH *)  
          MyWindowPtr := OpenWindow(MyWindow) ;
          IF MyWindowPtr <> NULL THEN
            MyWindowPtr^.ScreenTitle := ADR (MyScreenName) ;
            Finish := FALSE ;
            MyRastPortPtr := MyWindowPtr^.RPort ;
            SetDrMd (MyRastPortPtr,DrawingModeSet{Jam2}) ;
            MyTextAttr.taName := ADR (TextName);
            MyTextAttr.taYSize := 8;
            MyTextAttr.taStyle := FontStyleSet{};
            MyTextAttr.taFlags := FontFlagSet{};
            MyTextFontPtr := OpenFont (MyTextAttr);
            IF MyTextFontPtr <> NULL
              THEN SetFont (MyRastPortPtr,MyTextFontPtr^);
            END (* IF *);
            REPEAT
              Delay (1) ;
              IF CIAComDTR IN CIAB.ciapra
                THEN
                  SetAPen (MyRastPortPtr,3) ;
                  SetBPen (MyRastPortPtr,2) ;
                ELSE
                  SetAPen (MyRastPortPtr,0) ;
                  SetBPen (MyRastPortPtr,1) ;
                END ;
              Move (MyRastPortPtr,0,6) ;
              Text (MyRastPortPtr," DTR ",5) ;
              IF CIAComDSR IN CIAB.ciapra
                THEN
                  SetAPen (MyRastPortPtr,3) ;
                  SetBPen (MyRastPortPtr,2) ;
                ELSE
                  SetAPen (MyRastPortPtr,0) ;
                  SetBPen (MyRastPortPtr,1) ;
                END ;
              Move (MyRastPortPtr,40,6) ;
              Text (MyRastPortPtr," DSR ",5) ;
              IF CIAComRTS IN CIAB.ciapra
                THEN
                  SetAPen (MyRastPortPtr,3) ;
                  SetBPen (MyRastPortPtr,2) ;
                ELSE
                  SetAPen (MyRastPortPtr,0) ;
                  SetBPen (MyRastPortPtr,1) ;
                END ;
              Move (MyRastPortPtr,80,6) ;
              Text (MyRastPortPtr," RTS ",5) ;
              IF CIAComCTS IN CIAB.ciapra
                THEN
                  SetAPen (MyRastPortPtr,3) ;
                  SetBPen (MyRastPortPtr,2) ;
                ELSE
                  SetAPen (MyRastPortPtr,0) ;
                  SetBPen (MyRastPortPtr,1) ;
                END ;
              Move (MyRastPortPtr,120,6) ;
              Text (MyRastPortPtr," CTS ",5) ;
              IF CIAComCD IN CIAB.ciapra
                THEN
                  SetAPen (MyRastPortPtr,3) ;
                  SetBPen (MyRastPortPtr,2) ;
                ELSE
                  SetAPen (MyRastPortPtr,0) ;
                  SetBPen (MyRastPortPtr,1) ;
                END ;
              Move (MyRastPortPtr,160,6) ;
              Text (MyRastPortPtr," DCD ",5) ;
              IF MyWindowPtr^.MessageKey^.Class = IDCMPFlagSet{CloseWindowFlag}              THEN
                  MyMsgPortPtr := MyWindowPtr^.UserPort;
                  REPEAT
                  MyMessagePtr := GetMsg (MyMsgPortPtr);
                  UNTIL MyMessagePtr = NULL;
                  Finish := TRUE ;
              END ;
            UNTIL Finish ;  
            CloseFont (MyTextFontPtr^);
            CloseWindow (MyWindowPtr) ;
            END (* IF *) ;
          CloseLibrary (GraphicsBase) ;
        END (* IF *) ;
        CloseLibrary (ExecBase) ;
        END (* IF *) ;   
    CloseLibrary (IntuitionBase) ;
    END (* IF *) ;

END ShowModem;
  
BEGIN
  DOSBase := OpenLibrary(DOSName, 0);
  LF := 0A00H;
  myProcess := ProcessPtr(FindTask(NULL));
  
  IF myProcess^.prCLI <> NULL THEN
    (* running from CLI : *)
    ShowModem;
    CloseLibrary(DOSBase);
  ELSE
    (* running from Workbench : wait for the WB startup message *)
    WBenchMsg := WaitPort(ADR(myProcess^.prMsgPort));
    WBenchMsg := GetMsg(ADR(myProcess^.prMsgPort));
    args := WBenchMsg^.smArgList;
    
    IF args <> NULL THEN
      (* get the first argument and set the     *)
      (* current directory to the same directory *)
      oldLock := CurrentDir(FileLock(args^.waLock))
    END;
    
    (* get the toolwindow argument : *)
    IF WBenchMsg^.smToolWindow <> NULL THEN
      (* open the file *)
      name := ADDRESS(WBenchMsg^.smToolWindow);
      tool := Open(name^, ModeOldFile);
      IF tool <> 0 THEN
        fh :=  ADDRESS (tool);
        myProcess^.prConsoleTask := fh^.fhType;
          (* needed for window handlers *)
      END;
    END;
    
    ShowModem;
    CloseLibrary(DOSBase);
    Forbid;  (* very important - will fail without the forbid *)
    ReplyMsg(MessagePtr(WBenchMsg));
  END;
END Modem.