home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
perqb.tar.gz
/
perqb.tar
/
pq2con.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-06-06
|
12KB
|
417 lines
module KermitConnect;
{
{ Module for simulating a terminal.
{
{ The correct communications parameters must have
{ been set up before this routine is used.
{ }
{===========================} exports {====================================}
imports FileDefs from FileDefs;
procedure Terminal( EscChar : Char );
procedure SetSaveFile( NewSaveFile : PathName );
{===========================} private {====================================}
imports MenuUtils from MenuUtils;
imports system from system;
imports FileSystem from FileSystem;
imports IO_Unit from IO_Unit;
imports IOErrors from IOErrors;
imports IOUtils from IOUtils;
{ own modules: }
imports KermitScreen from KermitScreen;
imports KermitLineIO from KermitLineIO;
imports KermitParameters from KermitParameters;
{----------------------------------------------------------------------------}
const BBuffSize = 512; { number of bytes in FS-block }
{----------------------------------------------------------------------------}
var
BuffPtr : PDirBlk;
BufferIndex : -1..BBuffSize;
BlockNumber : FirstBlk..LastBlk;
Id : FileID;
GetC,SendC : char;
LineIndex : integer;
TermMenu, SpeedMenu, ParityMenu, StopMenu : pNameDesc;
{----------------------------------------------------------------------------}
{
procedure FlushBuffer;
var i : integer;
begin
for i:=MinBuffIndex to BufferIndex do
write(SaveFile,Buffer[i]);
BufferIndex:=MinBuffIndex - 1;
end;
}
{----------------------------------------------------------------------------}
procedure SaveInBuffer(ch:char);
begin
if BufferIndex = BBuffSize - 1 then
begin
FSBlkWrite(Id,BlockNumber,BuffPtr);
BlockNumber := BlockNumber + 1;
BufferIndex:=-1;
{ if XonXoff then RSPutChar(XOn); }
end;
BufferIndex:=BufferIndex+1;
BuffPtr^.ByteBuffer[BufferIndex]:=ord(ch);
end;
{----------------------------------------------------------------------------}
procedure OpenSave;
begin
Id := FSEnter( SaveFile );
if Id = 0 then begin
PutMessage('*** Illegal Log File name ***');
SaveFile := '';
end
else
begin
BlockNumber := FirstBlk;
BufferIndex:= - 1;
end;
SwitchWindow( MainWindow );
end; { OpenSave }
{----------------------------------------------------------------------------}
procedure CloseSave;
begin
if BufferIndex >= 0 then
begin
{ The last block is partially full }
FSBlkWrite(Id,BlockNumber,BuffPtr);
FSClose(Id,BlockNumber,(BufferIndex+1)*8);
{ last parameter is number of bits in last block }
end else
{ The last block is FULL }
FSClose(Id,BlockNumber-1,BBuffSize*8);
end; { CloseSave }
{----------------------------------------------------------------------------}
procedure SetSaveFile( NewSaveFile : PathName );
begin
if SaveFile<>'' then
CloseSave;
SaveFile := NewSaveFile;
if SaveFile<>'' then
OpenSave;
end;
{----------------------------------------------------------------------------}
procedure ChangeSaveFile;
var NewSaveFile : PathName;
CurrWin : WinType;
begin
CurrentWindow( CurrWin );
SwitchWindow( MessageWindow );
write( 'Enter name of new log file : ' );
readln( NewSaveFile );
SetSaveFile( NewSaveFile );
SwitchWindow( CurrWin );
end;
{----------------------------------------------------------------------------}
procedure TreatIncoming(ch:char);
begin
case ch of
BS : if LineIndex >= 1 then
BackSpace(' ')
else
write('');
CR : begin
LineIndex := 0;
if FileSave and not (SaveFile='') then
SaveInBuffer(ch);
PutChr(chr( LAnd( ord(ch), 127 )));
end;
NULL : ;
otherwise :
begin
LineIndex := LineIndex + 1;
if FileSave and not (SaveFile='') then
SaveInBuffer(ch);
PutChr(chr( LAnd( ord(ch), 127 )));
end;
end;
end;
{----------------------------------------------------------------------------}
function Xlat(ch:char): char;
var
Res : char;
begin
if ( LAnd(ord(ch),#200) <> 0 ) then { control-character }
Res := chr(LAnd(ord(ch),#37))
else
Res := ch;
Xlat := Res;
end;
{----------------------------------------------------------------------------}
procedure EscHelp;
begin
SwitchWindow( MainWindow );
writeln;
writeln(' ? - This message' );
writeln(' C - Close connection, return to Perq' );
writeln(' B - Send break' );
writeln(' 0 - Send a NUL' );
writeln(' Q - Quit (turn off) logging to a file' );
writeln(' R - Resume (turn on) logging to a file' );
writeln;
writeln('Typing the escape character will send it to the remote computer');
write ('Command>');
end;
{----------------------------------------------------------------------------}
function MakeUpper(ch:char): char;
var
Res : char;
begin
Res := Ch;
if ( LAnd(ord(ch),#200) <> 0 ) then { control-character }
Res := chr(LAnd(ord(ch),#177));
if ch in ['a'..'z'] then
Res := chr( ord(ch) - (ord('a') - ord('A')) );
MakeUpper := Res;
end;
{----------------------------------------------------------------------------}
procedure DoSetBaud;
function GetBaud:SpeedType;
begin { GetBaud }
GetBaud := recast(GetMenuAnswer(SpeedMenu,200),SpeedType);
end; { GetBaud }
begin
Baud := GetBaud;
RefreshBaud;
end;
{----------------------------------------------------------------------------}
procedure DoSetParity;
function GetKerParity:ParityType;
begin
GetKerParity := recast(GetMenuAnswer(ParityMenu,150),ParityType);
end;
begin
Parity := GetKerParity;
RefreshParity;
end;
{----------------------------------------------------------------------------}
procedure DoSetStop;
function GetStop:StopType;
begin
GetStop := recast(GetMenuAnswer(StopMenu,150),StopType);
end;
begin
StopBits := GetStop;
RefreshStopBits;
end;
{----------------------------------------------------------------------------}
procedure InitTMenu;
var SetMenu : pMenuEntry;
begin
AllocNameDesc( NTermComm, 0, TermMenu );
{$range-}
with TermMenu^ do begin
Header := 'Terminal commands';
Commands[ord(TermHelp) ] := '?';
Commands[ord(TermQuit) ] := 'QUIT terminal mode';
Commands[ord(TermSetBaud) ] := 'set BAUD';
Commands[ord(TermSetStop) ] := 'set STOP-BITS';
Commands[ord(TermSetParity) ] := 'set PARITY';
Commands[ord(TermSaveFile) ] := 'set LOG-FILE';
Commands[ord(TermOnSave) ] := 'set LOG ON';
Commands[ord(TermOffSave) ] := 'set LOG OFF';
Commands[ord(TermOnXonXoff) ] := 'set XON-XOFF ON';
Commands[ord(TermOffXonXoff)] := 'set XON-XOFF OFF';
end;
SetMenu := RootMenu^.NextLevel[ ord( MainSet ) ];
with SetMenu^ do begin
SpeedMenu := NextLevel[ ord( SetBaud ) ]^.MPtr;
ParityMenu := NextLevel[ ord( SetParity ) ]^.MPtr;
StopMenu := NextLevel[ ord( SetStop ) ]^.MPtr;
end;
{$range=}
end;
{----------------------------------------------------------------------------}
procedure GiveHelp;
begin
SwitchWindow( MainWindow );
writeln;
writeln(' Terminal commands: ');
writeln;
writeln('QUIT - return to Kermit-Perq main command level');
writeln('SET BAUD/STOP/PARITY - set line parameters');
writeln('SET LOG-FILE - enter name of file to log terminal session to');
writeln('SET LOG ON/OFF - turn log output on/off');
writeln('SET XON-XOFF ON/OFF - use/respect XON/XOFF handshake');
writeln;
SwitchWindow( TermWindow );
end;
{----------------------------------------------------------------------------}
procedure Terminal( EscChar : char );
var GetC, SendC : char;
done, HelpPrompt : boolean;
TComm : TermCommType;
function GetTermComm : TermCommType;
begin
GetTermComm:=recast(GetMenuAnswer(TermMenu,150),TermCommType);
end;
procedure DoTermComm( TComm : TermCommType );
begin
case TComm of
TermHelp : GiveHelp;
TermSetBaud : DoSetBaud;
TermSetParity : DoSetParity;
TermSetStop : DoSetStop;
TermQuit : ;
TermOnSave : FileSave := true;
TermOffSave : FileSave := false;
TermSaveFile : ChangeSaveFile;
TermOnXonXoff : XonXoff := true;
TermOffXonXoff : XonXoff := false;
end;
end;
handler IOWrErr( IOStatus : integer );
begin
PutMessage('Write error on line (possibly unplugged RS232 connector)');
end;
handler IORdErr( IOStatus : integer );
begin
PutMessage('Read error on line (possibly wrong speed or parity)');
end;
handler CtlC;
begin
ctrlcpending := false;
end;
begin
XonXoff := true; { enable handshake }
BlockNumber := FirstBlk;
new(BuffPtr); { Set up pointer to buffer }
InitTermScreen;
InitTMenu;
LineIndex := 0;
done:=false;
repeat
if GetChar( Idev, GetC ) then
{ IO Complete on RS232-line }
TreatIncoming(GetC);
if IOCRead(KeyBoard,SendC) = IOEIOC then
{ IO Complete on keyboard }
begin
if SendC <> EscChar then begin
{ Must handle conversion to ctrl-chars myself.
^DEL = BREAK
}
SendC:=Xlat(SendC);
{ Send character on RS232-line }
if SendC <> BreakKey then { not a break? }
Outbt( Odev, SendC)
else
SendBreak( 500 { milliseconds });
end else begin
HelpPrompt := false;
repeat
while IOCRead( KeyBoard, SendC ) <> IOEIOC do ;
if HelpPrompt then begin
writeln;
ChangeWindow( TermWindow );
end;
if SendC=EscChar then begin
SendC := Xlat( SendC );
Outbt( Odev, SendC );
end else
begin
SendC := MakeUpper( SendC );
case SendC of
'0': OutBt( Odev, chr(0) );
'B': SendBreak( 500 );
'C': TComm := TermQuit;
'Q': FileSave := FALSE;
'R': FileSave := TRUE;
'?': begin
EscHelp;
HelpPrompt := true;
end;
otherwise: write(Chr(7));
end;
end;
until SendC<>'?';
end;
end;
if TabSwitch then
begin
TComm:= GetTermComm;
DoTermComm( TComm );
end;
until TComm = TermQuit;
CleanupTermScreen;
DestroyNameDescr( TermMenu);
end.