(* PROGRAM TeleTalker			    07 Sep 83
   *)

(* N O T I C E	 ***   N O T I C E   ***   N O T I C E	 ***   N O T I C E *)
(*									   *)
(*		      Copyright 1979 - 1983, RB&A.			   *)
(*									   *)
(*	  Use by USUS members for non-commercial purposes encouraged.	   *)
(*			All other rights reserved.			   *)
(*									   *)
(* N O T I C E	 ***   N O T I C E   ***   N O T I C E	 ***   N O T I C E *)

(*$C Copyright 1979 - 1983, RB&A.  All rights reserved.*)



(* NOTE:    RB&A has granted SAGE Computer Technology permission to	   *)
(*	    distribute this software to SAGE Computer users.  By	   *)
(*	    allowing SAGE to distribute for commercial purposes, RB&A	   *)
(*	    does not thereby authorize any third party to distribute	   *)
(*	    or use this software for commercial purposes.		   *)



(*$D Musus-	 *)
(*$D SmartCom-	 *)
(*$D SmartModem+ *)

(*$I-*)	    (*$R-*)

PROGRAM TeleTalker;

USES
    (*$U RawCon.Code *)
	(*$L-*)
	RawConsole,
	(*$L+*)
    (*$U Rem.Hayes.Code *)
	(*$L-*)
	RemUnit;
	(*$L+*)
(*$L-*)(*$T T E L E T A L K E R	  -   D e c l a r a t i o n s	*)
(*$L+*)(*$P*)
(*$I #4:Sys.Parm.text *)

	(*$B Musus- *)
	Title	    = '	   R a n d y '' s    T e l e T a l k e r';
	(*$E Musus- *)
	(*$B Musus  *)
	Title	    = '	   R a n d y '' s    M U S U S T a l k e r';
	(*$E Musus  *)

	Titl2	    = '		    ';

	Copyright   = 'Copyright 1979-83, RB&A. All rights reserved.';


(* |xjm$d|nx|f8|ejb|.
   |xjm$m|nx+|ejb/r/TeleTalker//MususTalker/qun|.
   |xjm$sc|nx+|ejb/r/TeleTalker//SComTalker/qun|.


	  This may not be used for commercial gain without RB&A's
			explicit written consent.
*)
(*$P*)
(* Change log:

   07 Sep 83 IoCheck on Closes in RClose and Receive per BillBonham
   30 Aug 83 Blocksize changed to 1024 and legal textfiles attempted
   21 Aug 83 SmartCom option for when remote system does not echo
   10 Aug 83 fix .TEXT not being appended if name begis with "#"; Init sillies
   21 Jul 83 B(reak added to menu
   03 Jul 83 use RawConsole, variable Ca deleted
   27 Jun 83 T(haw, 7( and 8( options added.  Musus only controls ThawChar
   17 Jun 83 Musus ThawChar changed from ^Q to ^A
   15 Jun 83 try very hard not to drop the line across exits and reentries
   15 Jun 83 hacked up for Pascal IV.x
   18 Mar 83 moved console configuration to RawCon
   15 Mar 83 MUSUS conditional compilation hacks.
   13 Mar 83 reverse order of calls to InitRem and InitCon
   19 Feb 83 hacked to M2 from uE TeleTalker in Pascal
   07-Oct-81 hacked to new WD.IO per Bob P's April Draft

Note to implementors / adaptors

	I ask that you leave the Title..Copyright banner.

	This code was a quick hack, it is in no way waranteed.	It is meant
	to get you up, with something you can hack up yourself.


Later note (20 Feb 83)
	This is now a quick hack to a two year old quick hack.	What more
	warning can I give?

	This should absolutely not be taken as an example of any kind
	of programming!	 It is only a means of getting your system on
	the air.
*)
(*$P*)
(*
CONST contd. *)

	AttenChar	= 1;	    (* Ctrl-A from kbd breaks to menu *)
	BlkSz		= 1024;
	BlkMax		= 1023;
	Dle		= 16;
	(*$B Musus  *)
	ThawChar	= 1;	    (* set MUSUS PromptChar to Ctrl-A *)
	(*$E Musus  *)
	(*$B Musus- *)
	ThawChar	= 10;
	(*$E Musus- *)


TYPE

	Block		= PACKED ARRAY [0..BlkMax] OF CHAR;
	CharSet		= SET OF CHAR;
	FName		= STRING;
(*$P*)

VAR

	c		: CHAR;
	Sending		: BOOLEAN;
	Recording	: BOOLEAN;
	DleCount	: INTEGER;
	Frozen		: BOOLEAN;

	RcvFilPtr	: INTEGER;
	RcvBufPtr	: INTEGER;

	XmtBufPtr	: INTEGER;

	TextCharSet	: CharSet;

	XmtFile		: FILE;
	XmtBlk		: Block;
	XmtName		: FName;

	RcvFile		: FILE;
	RcvBlk		: Block;
	RcvName		: FName;
(*$L-*)(*$T T E L E T A L K E R	  -   I n i t i a l i z a t i o n  *)
(*$L+*)(*$P*)
PROCEDURE Init;
VAR
	c		: CHAR;
	Baud		: INTEGER;
	RemExists	: BOOLEAN;
	DialExists	: BOOLEAN;
	Rslt		: CrBaudResult;
BEGIN
	PAGE (OUTPUT);
	WRITELN; WRITELN (Title);
	WRITELN; WRITELN (Titl2, CompVer, ' of ', CompDate);
	WRITELN; WRITELN (Copyright);
	WRITELN; WRITE ('BaudRate: 1(200, 3(00, <Esc> ? ');
	REPEAT
	    c := CrGetKb
	    UNTIL c IN ['1', '3', ' ', CHR(13), CHR(27)];
	IF c = CHR(27) THEN
	    EXIT (TeleTalker)
	ELSE IF c = '3' THEN
	    Baud := 300
	ELSE
	    Baud := 1200;
	WRITELN (Baud);
	WRITELN ('<Ctrl-', CHR(AttenChar-1+ORD('A')), '> for option menu');
	
	CrCommInit (CrOrig, CHR(AttenChar), RemExists, DialExists);
	IF NOT RemExists THEN
	    EXIT (TeleTalker);
	CrSetCommunications (  TRUE,  (*Parity*)
			       TRUE,  (*Even*)
			       Baud,  (*Baud*)
				  7,  (*BitsPerChar*)
				  1,  (*StopBits*)
			     CrOrig,  (*Direction*)
	      'FlowIn,FlowOut,Mask',  (*Options*)
			       Rslt   (*Result*)     );
	IF Rslt <> CrSetOk THEN
	    EXIT (TeleTalker);
	
	Sending	    := FALSE;
	Recording   := FALSE;
	(*$B SmartCom+ *)
	TextCharSet := [CHR(8), CHR(9), CHR(12), CHR(13), ' '..'~'];
	(*$E SmartCom+ *)
	(*$B SmartCom- *)
	TextCharSet := [CHR(8), CHR(13), ' '..'~'];
	(*$E SmartCom- *)
	(*$B SmartModem *)
	CrPutRem (CHR(13));
	CrPutRem ('A');	 CrPutRem ('T');
	CrPutRem ('V');	 CrPutRem ('1');
	CrPutRem ('E');	 CrPutRem ('1');
	IF CrCarrier THEN
	    CrPutRem ('O');
	CrPutRem ('Q');	 CrPutRem (CHR(13))
	(*$E SmartModem *)
	END;
(*$L-*)(*$T T E L E T A L K E R	  -   U t i l i t y   P r o c e d u r e s   *)
(*$L+*)(*$P*)
(*$B SmartModem- *)
PROCEDURE Options;  FORWARD;

PROCEDURE NoCts;
CONST
	Msg	    = 'LOST CARRIER';
VAR
	i	    : INTEGER;
	c	    : CHAR;
BEGIN
	WRITELN (CHR(7));
	IF NOT CrKbStat THEN
	    WRITE (Msg);
	REPEAT
	    UNTIL CrClearToSend OR CrKbStat;
	IF NOT CrKbStat THEN
	    FOR i := 1 TO 12 DO
		WRITE (CHR(8), ' ', CHR(8))
	ELSE BEGIN
	    c := CrGetKb;
	    WRITELN;
	    Options
	    END
	END;
(*$E SmartModem- *)


PROCEDURE BlkWrite;
VAR
	SpareBlk    : Block;
	LineHold    : Block;
	i	    : INTEGER;
BEGIN
	i := BlkSz + SCAN (-BlkSz, =CHR(13), RcvBlk[BlkMax]);
	IF i < BlkSz THEN BEGIN
	    MOVERIGHT (RcvBlk[i], LineHold, BlkSz - i);
	    FILLCHAR (RcvBlk[i], BlkSz - i, CHR(0))
	    END;
	REPEAT
	    WHILE BLOCKWRITE (RcvFile, RcvBlk[0], 2, RcvFilPtr) <> 2 DO BEGIN
		WRITELN;
		WRITE ('Write error on disk.')
		END;
	    WHILE BLOCKREAD (RcvFile, SpareBlk[0], 2, RcvFilPtr) <> 2 DO BEGIN
		WRITELN;
		WRITE ('ReRead error on disk.')
		END
	    UNTIL SpareBlk = RcvBlk;
	RcvFilPtr := RcvFilPtr + 2;
	MOVERIGHT (LineHold, RcvBlk[0], BlkSz - i);
	RcvBufPtr := BlkSz - i
	END;
(*$L-*)(*$T T E L E T A L K E R	  -   O p t i o n s   M e n u	*)
(*$L+*)(*$P*)

PROCEDURE Options;
VAR
	c	    : CHAR;


    PROCEDURE UpCase (VAR s : STRING);
    VAR
	i	    : INTEGER;
    BEGIN
	FOR i := 1 TO LENGTH(s) DO
	    IF s[i] IN ['a'..'z'] THEN
		s[i] := CHR ( ORD(s[i]) - ORD('a') + ORD('A') )
	END;


    PROCEDURE RClose;
    BEGIN
	IF (RcvBufPtr = 0) OR (RcvBlk[RcvBufPtr-1] <> CHR(13)) THEN BEGIN
	    RcvBlk[RcvBufPtr] := CHR(13);
	    RcvBufPtr := SUCC(RcvBufPtr)
	    END;
	FILLCHAR (RcvBlk[RcvBufPtr], BlkSz - RcvBufPtr, CHR(0));
	BlkWrite;
	CLOSE (RcvFile, LOCK);
	IF IORESULT <> 0 THEN
	    WRITELN (CHR(7), 'ERROR in CLOSE')
	END;
(*$L-*)(*$T T E L E T A L K E R	  -   S e n d	O p t i o n *)
(*$L+*)(*$P*)

    PROCEDURE OptSend;
    VAR
	c	    : CHAR;
    BEGIN
	WRITELN ('Send');
	IF Sending THEN BEGIN
	    WRITE ('Currently Sending ', XmtName, ' Close it ? ');
	    c := CrGetKb;
	    IF (c = 'y') OR (c = 'Y') THEN BEGIN
		CLOSE (XmtFile, Normal);
		Sending := FALSE;
		WRITELN ('Closed')
		END
	    ELSE
		WRITELN ('Left open')
	    END
	ELSE BEGIN
	    REPEAT
		WRITE ('Send what textfile ? ');
		READLN (XmtName);
		IF LENGTH (XmtName) > 0 THEN BEGIN
		    UpCase (XmtName);
		    IF XmtName[Length(XmtName)] = '.' THEN
			DELETE (XmtName, Length(XmtName), 1)
		    ELSE IF XmtName[Length(XmtName)] <> ':' THEN
			XmtName := CONCAT (XmtName, '.TEXT');
		    RESET (XmtFile, XmtName);
		    IF IORESULT = 0 THEN BEGIN
			Sending	 := TRUE;
			DleCount := 0;
			Frozen	 := FALSE;
			WRITELN (XmtName, ' Opened')
			END
		    END
		 UNTIL (LENGTH(XmtName) = 0) OR (IORESULT = 0);
	    IF LENGTH (XmtName) >= 5 THEN
		IF COPY (XmtName, LENGTH(XmtName)-4, 5) = '.TEXT' THEN
		    IF BLOCKREAD (XmtFile, XmtBlk[0], 2) <> 2 THEN;
	    XmtBufPtr := BlkSz
	    END
	END;
(*$L-*)(*$T T E L E T A L K E R	  -   R e c e i v e   O p t i o n *)
(*$L+*)(*$P*)
    PROCEDURE OptReceive;
    VAR
	c	    : CHAR;
    BEGIN
	WRITELN ('Record');
	IF Recording THEN BEGIN
	    WRITE ('Currently Recording ', RcvName, ' C(lose, P(urge ? ');
	    c := CrGetKb;
	    IF (c = 'c') OR (c = 'C') THEN BEGIN
		RClose;
		Recording := FALSE;
		WRITELN ('Closed')
		END
	    ELSE IF (c = 'p') OR (c = 'P') THEN BEGIN
		CLOSE (RcvFile, PURGE);
		IF IORESULT = 0 THEN BEGIN
		    Recording := FALSE;
		    WRITELN ('Purged')
		    END
		ELSE
		    WRITELN (CHR(7), 'ERROR in CLOSE')
		END
	    ELSE
		WRITELN ('Recording continued')
	    END
(*$P*)
	ELSE BEGIN
	    REPEAT
		WRITE ('Record as what textfile ? ');
		READLN (RcvName);
		IF Length (RcvName) > 0 THEN BEGIN
		    UpCase (RcvName);
		    IF RcvName[Length(RcvName)] = '.' THEN
			DELETE (RcvName, Length(RcvName), 1)
		    ELSE IF RcvName[Length(RcvName)] <> ':' THEN
			 RcvName := CONCAT (RcvName, '.TEXT');
		    RESET (RcvFile, RcvName);
		    IF IOResult = 0 THEN BEGIN
			WRITE (RcvName, ' Exists, P(urge ? ');
			c := CrGetKb;
			IF (c = 'y') OR (c = 'Y') THEN BEGIN
			    CLOSE (RcvFile, PURGE);
			    WRITELN ('Purged')
			    END
			ELSE BEGIN
			    CLOSE (RcvFile, LOCK);
			    RcvName := '';
			    WRITELN ('Saved');
			    EXIT (OptReceive)
			    END
			END;
		    REWRITE (RcvFile, RcvName);
		    IF IORESULT = 0 THEN BEGIN
			Recording := TRUE;
			WRITELN (RcvName, ' Opened')
			END
		    END
		UNTIL (LENGTH(RcvName) = 0) OR (IORESULT = 0);
	    IF LENGTH(RcvName) >= 5 THEN
		IF COPY (RcvName, Length(RcvName)-4, 5) = '.TEXT' THEN BEGIN
		    FILLCHAR (RcvBlk[0], BlkSz, CHR(0));
		    IF BLOCKWRITE (RcvFile, RcvBlk[0], 2) <> 2 THEN;
		    RcvFilPtr := 2
		    END
	    ELSE
		RcvFilPtr := 0;
	    RcvBufPtr := 0
	    END
	END;
(*$L-*)(*$T T E L E T A L K E R	  -   O p t i o n   M e n u  *)
(*$L+*)(*$P*)

    PROCEDURE OptExit;
    BEGIN
	WRITELN ('Exit');
	IF Recording THEN BEGIN
	    RClose;
	    Recording := FALSE
	    END;
	IF Sending THEN BEGIN
	    CLOSE (XmtFile, NORMAL);
	    Sending := FALSE
	    END;
	EXIT (TeleTalker)
	END;




BEGIN (* Options *)
	REPEAT
	    WRITE (
'Options: S(end, R(ecord, G(o, B(reak, T(haw, 7(, 8(, E(xit - ');
	    c := CrGetKb;
	    IF c = CHR(13) THEN
		c := 'G'
	    ELSE IF c IN ['a'..'z'] THEN
		c := CHR ( ORD(c) - ORD('a') + ORD('A') );
	    IF c IN ['S', 'R', 'G', 'B', 'T', '7', '8', 'E'] THEN
		CASE c OF
		    'S' : OptSend;
		    'R' : OptReceive;
		    'G' : WRITELN ('Go');
		    'B' : BEGIN
			    WRITELN ('Break');
			    CrBreak
			    END;
		    'T' : BEGIN
			    WRITELN ('Thawed');
			    Frozen := FALSE
			    END;
		    '7' : BEGIN
			    WRITELN ('7 Cleared & Thawed');
			    UNITCLEAR (7);
			    Frozen := FALSE
			    END;
		    '8' : BEGIN
			    WRITELN ('8 Cleared');
			    UNITCLEAR (8)
			    END;
		    'E' : OptExit
		    END
	    ELSE
		WRITELN (CHR(7))
	    UNTIL c = 'G'
	END;
(*$L-*)(*$T T E L E T A L K E R	  -   M a i n	P r o c e d u r e  *)
(*$L+*)(*$P*)

BEGIN (*TeleTalker*)
	Init;
	WHILE TRUE DO BEGIN
	    (*$B SmartModem- *)
	    IF NOT CrClearToSend THEN
		NoCts;
	    (*$E SmartModem- *)
	    IF CrRemStat THEN BEGIN
		c := CrGetRem;
		(* c := CHR ( ORD ( ODD(ORD(c)) AND ODD(127) ) ); *)
		IF c = CHR(ThawChar) THEN
		    Frozen := FALSE;
		IF c IN TextCharSet THEN BEGIN
		    WRITE (c);
		    IF Recording AND (c <> CHR(8)) THEN BEGIN
			RcvBlk[RcvBufPtr] := c;
			IF RcvBufPtr < BlkMax THEN
			    RcvBufPtr := SUCC(RcvBufPtr)
			ELSE
			    BlkWrite
			END
		    END
		END
(*$P*)
	    ELSE BEGIN
		c := CHR(0);
		IF CrKbStat THEN BEGIN
		    c := CrGetKb;
		    IF Sending OR (c = CHR(AttenChar)) THEN BEGIN
			WRITELN;
			Options;
			c := CHR(0)
			END
		    END
		ELSE IF Sending AND NOT Frozen THEN
		    IF DleCount > 0 THEN BEGIN
			c := ' ';
			DleCount := PRED(DleCount)
			END
		    ELSE IF XmtBufPtr >= BlkSz THEN
			IF BLOCKREAD (XmtFile, XmtBlk[0], 2) = 2 THEN
			    XmtBufPtr := 0
			ELSE BEGIN
			    CLOSE (XmtFile, NORMAL);
			    WRITELN (XmtName, ' Finished');
			    Sending := FALSE
			    END
		    ELSE BEGIN
			c	  := XmtBlk[XmtBufPtr];
			XmtBufPtr := SUCC(XmtBufPtr);
			IF DleCount < 0 THEN BEGIN
			    DleCount := ORD(c) - 32;
			    IF DleCount < 0 THEN
				DleCount := 0;
			    c := CHR(0)
			    END
			ELSE IF c = CHR(Dle) THEN BEGIN
			    DleCount := -1;
			    c := CHR(0)
			    END
			ELSE
			    (*$B SmartCom- *)
			    Frozen := c = CHR(13)
			    (*$E SmartCom- *)
			END;
		IF c <> CHR(0) THEN BEGIN
		    CrPutRem (c);
		    (*$B SmartCom+ *)
		    WRITE (c)
		    (*$E SmartCom+ *)
		    END
		END
	    END
	END.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    