Category : Modula II Source Code
Archive   : FM2EXA.ZIP
Filename : TALK.MOD

 
Output of file : TALK.MOD contained in archive : FM2EXA.ZIP
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;
(* We must run with interrupts enabled because the AT's BIOS
ISR depends on these interrupts to talk to the keyboard!
*)
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 );
WHILE KeyPressed() DO
(* Because we run the Keyboard Trap w/ interrupts enabled,
it is possible that more than 1 key was pressed for a
given signal sent to us.
*)
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 OR (port < 1) OR (port > 2) 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.

  3 Responses to “Category : Modula II Source Code
Archive   : FM2EXA.ZIP
Filename : TALK.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/