Turbo Toolbox/Turbo_Toolbox.iso/1989/09/modula/talk.mod

Text File | 1987-10-17 | 14.9 KB | 521 lines

MODULE Talk;

(* (C) Copyright 1987 Fitted Software Tools. All rights reserved.

    This module is part of the example multitasking communications program
    provided with the Fitted Software Tools' Modula-2 development system.

    Registered users may use this program as is, or they may modify it to
    suit their needs or as an exercise.

    If you develop interesting derivatives of this program and would like
    to share it with others, we encourage you to upload a copy to our BBS.
*)


(*$L+*)

IMPORT Terminal, Display;
FROM SYSTEM     IMPORT  ASSEMBLER, ADDRESS, ADR;
FROM System     IMPORT  GetArg, TermProcedure, Terminate,
                        GetVector, ResetVector;
FROM InOut      IMPORT  WriteString, WriteCard, ReadCard, WriteLn;
FROM Strings    IMPORT  CompareStr, Concat;
FROM Keyboard   IMPORT  F10, KeyPressed, GetKeyCh;
FROM RS232      IMPORT  RS232Input,
                        Init, ResetPars, GetCom, PutCom, XON, XOFF;
FROM ASCII      IMPORT  FF, CR, DEL, BEL, LF, BS, HT, ESC, CtrlS, CtrlQ;
FROM NumberConversion
                IMPORT  StringToCard;
FROM Display    IMPORT  ScrollUp, DisplayLine, Goto;
FROM Windows    IMPORT  Window, OpenWindow, CloseCurWindow;
FROM Menu       IMPORT  PopMenu;
FROM XModem     IMPORT  SendFile, ReceiveFile;
FROM Files      IMPORT  NORMAL, READ, Open, Create, Close, Read, Write;
FROM Kernel     IMPORT  SignalHeader, LockHeader, InitSignal, InitLock,
                        NewProcess, Wait, WaitIO, Signal, Lock, Unlock;

CONST
    comBuffSize = 2048;
    attrNormal  = 07H;
    attrReverse = 70H;

VAR Capturing       :BOOLEAN;       (* capture file open *)
    Sending         :BOOLEAN;       (* sending a file *)
    Xon             :BOOLEAN;       (* XON/XOFF enabled *)

    DisplayLock     :LockHeader;    (* only one process may write
                                        to the screen at any time *)
    SendLock        :LockHeader;    (* to suspend SendFile when we
                                        receive an XOFF *)

(*** Program command and reconfiguration ***)

VAR
    port    :CARDINAL;
    baud    :CARDINAL;
    parity  :BOOLEAN;
    evenp   :BOOLEAN;
    bits    :CARDINAL;


PROCEDURE Command;
VAR cmdstr  :ARRAY [0..255] OF CHAR;
    cmd     :CARDINAL;
    fn      :ARRAY [0..65] OF CHAR;
    done    :BOOLEAN;
    w       :Window;

    PROCEDURE XModemCom;    (* config COM for XModem *)
    BEGIN
        XOFF;
        ResetPars( baud, 1, FALSE, FALSE, 8, ok );
    END XModemCom;

    PROCEDURE ResetCom;     (* reinit COM after Xmodem *)
    BEGIN
        ResetPars( baud, 1, parity, evenp, bits, ok );
        IF Xon THEN XON END;
    END ResetCom;

BEGIN (* Command *)
    Lock( DisplayLock );
    Concat( "|Parameters|Send Text|Xmit Xmodem|Rcv Xmodem",
            "|Open capFile|Close capFile|Quit",
            cmdstr );
    PopMenu( 5,5, cmdstr, 0,FALSE,cmd);
    CASE cmd OF
        0:  ;
        |
        1:  (* Reconfig *)
            CloseCurWindow; Reconfig
        |
        2:  (* Send text *)
            OpenWindow( w, 5,22, 8,75, TRUE, "" );
            Terminal.WriteString( " File name: " );
            Terminal.ReadLine( fn );
            IF fn[0] <> 0C THEN
                Open( SendFD, fn, READ );
                IF SendFD = -1 THEN
                    Terminal.WriteString( " --- cannot open file" );
                    Terminal.Read( c );
                ELSE
                    Sending := TRUE;
                    SendPtr := 0; BuffEnd := 0;
                    Signal( SendTextSignal );
                END;
            END;
            CloseCurWindow;
            CloseCurWindow;    (* MENU window *)
        |
        3:  (* Xmit file *)
            OpenWindow( w, 5,22, 8,75, TRUE, "" );
            Terminal.WriteString( " File to send: " );
            Terminal.ReadLine( fn );
            IF fn[0] <> 0C THEN
                Open( XmodemFD, fn, READ );
                IF XmodemFD = -1 THEN
                    Terminal.WriteString( " --- cannot open file" );
                    Terminal.Read( c );
                ELSE
                    XModemCom;
                    SendFile( fn, XmodemFD, done );
                    Close( XmodemFD );
                    ResetCom;
                END;
            END;
            CloseCurWindow;
            CloseCurWindow;    (* MENU window *)
        |
        4:  (* Rcv file *)
            OpenWindow( w, 5,22, 8,75, TRUE, "" );
            Terminal.WriteString( " File to receive: " );
            Terminal.ReadLine( fn );
            IF fn[0] <> 0C THEN
                Create( XmodemFD, fn, NORMAL );
                IF XmodemFD = -1 THEN
                    Terminal.WriteString( " --- cannot create file" );
                    Terminal.Read( c );
                ELSE
                    XModemCom;
                    ReceiveFile( fn, XmodemFD, done );
                    Close( XmodemFD );
                    ResetCom;
                END;
            END;
            CloseCurWindow;
            CloseCurWindow;    (* MENU window *)
        |
        5:  (* Open capFile *)
            IF Capturing THEN StopCapture END;
            OpenWindow( w, 5,22, 8,75, TRUE, "" );
            Terminal.WriteString( " File name: " );
            Terminal.ReadLine( fn );
            IF fn[0] <> 0C THEN
                Create( CaptureFD, fn, NORMAL );
                IF CaptureFD = -1 THEN
                    Terminal.WriteString( " --- cannot create file" );
                    Terminal.Read( c );
                ELSE
                    Capturing := TRUE;
                    CapPtr := 0;
                END;
            END;
            CloseCurWindow;
            CloseCurWindow;    (* MENU window *)
        |
        6:  (* Close capFile *)
            IF Capturing THEN
                StopCapture;
            END;
            CloseCurWindow;
        |
        7:  (* Quit *)
            CloseCurWindow;
            IF Capturing THEN StopCapture END;
            ScrollUp( 0, 0,0, 25,79, attrNormal );
            Terminate(0);
    END;
    Unlock( DisplayLock );
END Command;


PROCEDURE Reconfig;
VAR item :CARDINAL;
    cmd :CARDINAL;
    c :CHAR;
    w :Window;

    PROCEDURE putBaud;
    BEGIN
        Goto( 1,1 ); WriteString( "Baud Rate >" );
        Goto( 1,15 ); WriteString( "      " );
        Goto( 1,15 ); WriteCard( baud, 1 );
    END putBaud;

    PROCEDURE putParity;
    BEGIN
        Goto( 3,1 ); WriteString( "Parity >" );
        Goto( 3,15 );
        IF parity & evenp THEN WriteString( "EVEN" );
        ELSIF parity THEN WriteString( "ODD " );
        ELSE WriteString( "NONE" );
        END;
    END putParity;

    PROCEDURE putXon;
    BEGIN
        Goto( 5,1 ); WriteString( "Xon/Off " );
        Goto( 5,15 );
        IF Xon THEN WriteString( "enabled " )
        ELSE WriteString( "disabled" )
        END;
    END putXon;

BEGIN (* Reconfig *)
    OpenWindow( w, 0,0, 23,40, TRUE, "Terminal Reconfiguration" );
    putBaud;
    putParity;
    putXon;
    LOOP
        PopMenu( 9,7, "Change|Baud|Parity|Xon/Xoff", 0, FALSE, item );
        IF item = 0 THEN
            EXIT
        ELSE
            CASE item OF
            1:  PopMenu( 10,10, "baud|300|600|1200|2400|4800|9600|19200|38400",
                         0, TRUE, cmd );
                CloseCurWindow;    (* loop MENU *)
                IF cmd > 0 THEN
                    baud := 300;
                    WHILE cmd > 1 DO
                        INC( baud, baud );
                        DEC( cmd );
                    END;
                    putBaud;
                END;
            |
            2:  PopMenu( 11,10, "parity|EVEN|ODD|NONE", 0, TRUE, cmd );
                CloseCurWindow;    (* loop MENU *)
                IF cmd > 0 THEN
                    parity := cmd < 3;
                    evenp := cmd = 1;
                    putParity;
                    IF parity THEN bits := 7
                    ELSE bits := 8
                    END;
                END;
            |
            3:  Xon := NOT Xon;
                IF Xon THEN XON ELSE XOFF END;
                CloseCurWindow;    (* loop MENU *)
                putXon;
            END;
        END;
    END;
    Init( port, baud, 1, parity, evenp, bits, comBuffSize, ok );
    IF NOT ok THEN WriteString( "failed rs232 Init" ); Terminate(1) END;
    CloseCurWindow;
END Reconfig;



CONST BUFFSIZE = 512;

VAR
    XmodemFD    :INTEGER;
    SendFD      :INTEGER;
    SendBuff    :ARRAY [0..BUFFSIZE-1] OF CHAR;
    BuffEnd     :CARDINAL;
    SendPtr     :CARDINAL;

CONST
    CapBufferSize = 512;

VAR
    CaptureFD   :INTEGER;
    CapBuffer   :ARRAY [0..512] OF CHAR;
    CapPtr      :CARDINAL;


PROCEDURE Capture( c :CHAR );
BEGIN
    CapBuffer[CapPtr] := c;
    INC( CapPtr );
    IF CapPtr >= CapBufferSize THEN
        FlushCaptureBuffer
    END;
END Capture;


PROCEDURE FlushCaptureBuffer;
VAR n :CARDINAL;
BEGIN
    IF CapPtr > 0 THEN
        Write( CaptureFD, ADR(CapBuffer), CapPtr, n );
        CapPtr := 0;
    END;
END FlushCaptureBuffer;


PROCEDURE StopCapture;
BEGIN
    FlushCaptureBuffer;
    Close( CaptureFD );
    Capturing := FALSE;
END StopCapture;


(*PROCESS*) PROCEDURE ReadRS232;
(*
    This process Waits on Signals from the RS232 driver.
    On each signal, we try to process a COM input character.
*)
VAR c   :CHAR;
    ok  :BOOLEAN;
    lockedSend :BOOLEAN;
BEGIN
    lockedSend := FALSE;
    LOOP
        Wait( RS232Input );
        IF Sending THEN
            GetCom( c, ok );
            IF ok THEN
                IF (c = CtrlS) OR (c = CtrlQ) THEN
                    IF c = CtrlS THEN
                        Lock( SendLock );
                        lockedSend := TRUE;
                    ELSIF c = CtrlQ THEN
                        Unlock( SendLock );
                    END;
                ELSE
                    IF Capturing THEN Capture( c ) END;
                    Display.Write( c );
                END;
            END;
        ELSIF lockedSend THEN Unlock( SendLock )
        ELSE
            Lock( DisplayLock );
            GetCom( c, ok );
            IF ok THEN
                IF Capturing THEN Capture( c ) END;
                Display.Write( c );
            END;
            Unlock( DisplayLock );
        END;
    END;
END ReadRS232;


VAR KeyboardInput :SignalHeader;

MODULE KeyboardTrap[1];

    IMPORT ASSEMBLER, ADDRESS, TermProcedure,
           GetVector, ResetVector, WaitIO, Signal, KeyboardInput;

    EXPORT CheckKeyboard;

    VAR KeyboardHandler :ADDRESS;

    (*PROCESS*) PROCEDURE CheckKeyboard;
    (*
        This process Signals ReadKbd whenever a keyboard interrupt occurs.
    *)
    BEGIN
        LOOP
            WaitIO( 9 );
            ASM
                PUSHF
                CALL    FAR KeyboardHandler
            END;
            Signal( KeyboardInput );
        END;
    END CheckKeyboard;

    PROCEDURE restoreKeyboard;
    BEGIN
        ResetVector( 9, KeyboardHandler );
    END restoreKeyboard;

BEGIN
    GetVector( 9, KeyboardHandler );
    TermProcedure( restoreKeyboard );
END KeyboardTrap;


(*PROCESS*) PROCEDURE ReadKbd;
(*
    This process Waits for Signals from CheckKeyboard.
    On a signal, we poll the keyboard for possible input.
*)
VAR i   :CARDINAL;
    c   :CHAR;
BEGIN
    LOOP
        Wait( KeyboardInput );
        IF KeyPressed() THEN
            GetKeyCh( c );
            IF Sending THEN
                IF c = ESC THEN
                    Sending := FALSE;
                    Signal( RS232Input );   (* wake up in case of locked Send *)
                END;
            ELSIF c = F10 THEN Command
            ELSE
                PutCom( c );
            END;
        END;
    END;
END ReadKbd;


VAR SendTextSignal :SignalHeader;

(*PROCESS*) PROCEDURE SendText;
(*
    This process Waits on the SendTextSignal.
    On receipt of a signal, the process goes to work sending the
    text file to the remote system.
    During the send loop (WHILE sending), SendLock is used so that
    the ReadRS232 process may communicate the receipt of XOFF and XON
    characters from the other system.

    Notice that Sending can be turned off by the ReadKbd process,
    which "shares" this global variable with SendText.
*)
BEGIN
    LOOP
        Wait( SendTextSignal );
        IF Sending THEN
            WHILE Sending DO
                Lock( SendLock );
                IF SendPtr >= BuffEnd THEN
                    Read( SendFD, ADR(SendBuff), BUFFSIZE, BuffEnd );
                    SendPtr := 0;
                    Sending := BuffEnd <> 0;
                END;
                IF Sending THEN
                    PutCom( SendBuff[SendPtr] );
                    INC( SendPtr );
                END;
                Unlock( SendLock );
            END;
            Close( SendFD );
        END;
    END;
END SendText;


PROCEDURE usage;
BEGIN
    WriteString( "usage: Talk [port# [baud [parity]]]" ); WriteLn;
    WriteString( "       port: 1 | 2" ); WriteLn;
    WriteString( "       baud: 50, 110, 300..38400" ); WriteLn;
    WriteString( "       parity: NONE | EVEN | ODD" ); WriteLn;
    Terminate(1);
END usage;


(*** Main program starts here ***)

VAR
    ok  :BOOLEAN;
    c   :CHAR;
    par :CARDINAL;
    w   :Window;
    arg :ARRAY [0..10] OF CHAR;
    n   :CARDINAL;

BEGIN
    Sending := FALSE; Capturing := FALSE;
    GetArg( arg, n );
    IF n > 0 THEN
        StringToCard( arg, port, ok );
        IF NOT ok THEN usage END;
    ELSE port := 1
    END;
    GetArg( arg, n );
    IF n > 0 THEN
        StringToCard( arg, baud, ok );
        IF NOT ok THEN usage END;
    ELSE baud := 1200
    END;
    GetArg( arg, n );
    IF n > 0 THEN
        REPEAT DEC(n); arg[n] := CAP(arg[n])
        UNTIL n = 0;
        IF CompareStr( arg, "EVEN" ) = 0 THEN
            parity := TRUE; evenp := TRUE; bits := 7;
        ELSIF CompareStr( arg, "ODD" ) = 0 THEN
            parity := TRUE; evenp := FALSE; bits := 7;
        ELSIF CompareStr( arg, "NONE" ) = 0 THEN
            parity := FALSE; evenp := FALSE; bits := 8;
        ELSE
            usage
        END;
    ELSE
        parity := FALSE; evenp := FALSE; bits := 8;
    END;
    DisplayLine(
    "    I TALK  (C)Copyright 1987 F S T. All rights reserved.    F10 = Menu",
         25, attrReverse
    );
    OpenWindow( w, 0,0, 23,79, FALSE, "" );

    InitSignal( KeyboardInput );
    InitSignal( SendTextSignal );
    InitLock( SendLock );
    InitLock( DisplayLock );

    NewProcess( CheckKeyboard, 512, TRUE );
    NewProcess( ReadRS232, 512, FALSE );
    NewProcess( SendText, 512, FALSE );

    Init( port, baud, 1, parity, evenp, bits, comBuffSize, ok );
    IF NOT ok THEN Terminate(1) END;
    XON; Xon := TRUE;

    ReadKbd;

END Talk.