// FtpTelnet.bcpl - Telnet window for the Alto FTP
// Copyright Xerox Corporation 1979, 1980, 1981, 9182
// Last modified February 14, 1982  5:50 PM by Boggs

get "Pup.decl"
get "AltoDefs.d"
get "CmdScan.decl"

external
[
// outgoing procedures
TelnetTop; TelnetQuit
TelnetKey; TelnetFinishProc

// incoming procedures
InitializeContext; Block
Allocate; Free; Enqueue; Unqueue
Wss; OtherPup; ReleasePBI; SetAllocation
InitCmd; GetPartner; GetString; CmdError
Puts; Gets; Closes; Resets; Errors
SetTimer; TimerHasExpired
OpenLevel1Socket; OpenRTPSocket; CreateBSPStream
CloseLevel1Socket; CloseRTPSocket
BSPPutMark; BSPGetMark; BSPForceOutput

// incoming statics
sysZone; lvUserFinishProc; ctxQ; telnetDsp
numTelLines; fontWidth
telnetSoc; telnetKeys; savedTelnetUFP
]

static
[
telnetStr; dataMark
netToDspCtx; keysToNetCtx
telnConnFlag = false
]

manifest
[
markSync = 1
markLineWidth = 2
markPageLength = 3
markTerminalType = 4
markTiming = 5
markTimingReply = 6

termTypeScope = 12b

socketTelnet = 1	// well known Telnet rendezvous socket
]

//----------------------------------------------------------------------------
let TelnetTop(ctx) be
//----------------------------------------------------------------------------
[
let cs = nil
cs = InitCmd(256, 2, 0, 0, 0, telnetKeys, telnetDsp) repeatwhile cs eq 0
Wss(cs, "*NConnect To: ")
let host = GetString(cs, 0, Wss, "Host name or address")
Wss(cs, "...")
let port = vec lenPort
let ok = GetPartner(host, cs, port, 0, socketTelnet)
Free(sysZone, host)
unless ok do Errors(cs, ecCmdDestroy)
OpenLevel1Socket(telnetSoc, 0, port)
SetAllocation(telnetSoc, 3, 2, 2)
OpenRTPSocket(telnetSoc, ctxQ, modeInitAndReturn, 0, TelnetInterrupt)
let timer = nil; SetTimer(lv timer, 6000)
Block() repeatwhile telnetSoc>>RTPSoc.state eq stateRFCOut &
 not TelnetKey() & not TimerHasExpired(lv timer)
unless telnetSoc>>RTPSoc.state eq stateOpen do
   [
   CmdError(cs, "Failed to connect")
   CloseRTPSocket(telnetSoc, 0)
   CloseLevel1Socket(telnetSoc)
   Errors(cs, ecCmdDestroy)
   ]
Wss(telnetDsp, "Open.*N")
Closes(cs)

telnetStr = CreateBSPStream(telnetSoc)
telnConnFlag = true
dataMark = 0
BSPPutMark(telnetSoc, markTerminalType)
Puts(telnetStr, termTypeScope)
BSPPutMark(telnetSoc, markPageLength)
Puts(telnetStr, numTelLines-1)
BSPPutMark(telnetSoc, markLineWidth)
Puts(telnetStr, ((telnetDsp>>DS.cdcb>>DCB.width*16)/fontWidth)-2)
BSPForceOutput(telnetSoc)
DoTelnet()
TelnetQuit()
] repeat

//----------------------------------------------------------------------------
and TelnetKey() = (kbdAd!3 & 5) ne 5
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and DoTelnet() be
//----------------------------------------------------------------------------
[
let ktnctx = vec 200; keysToNetCtx = ktnctx
let ntdctx = vec 200; netToDspCtx = ntdctx
Enqueue(ctxQ, InitializeContext(keysToNetCtx, 200, KeysToNet))
Enqueue(ctxQ, InitializeContext(netToDspCtx, 200, NetToDsp))
Block() repeatuntil telnetSoc>>BSPSoc.state ne stateOpen
]

//----------------------------------------------------------------------------
and TelnetQuit() be
//----------------------------------------------------------------------------
[
if telnConnFlag then
   [
   telnConnFlag = false
   Unqueue(ctxQ, keysToNetCtx)
   Unqueue(ctxQ, netToDspCtx)
   Closes(telnetStr)
   ]
]

//----------------------------------------------------------------------------
and TelnetFinishProc() be
//----------------------------------------------------------------------------
[
TelnetQuit()
@lvUserFinishProc = savedTelnetUFP
]

//----------------------------------------------------------------------------
and KeysToNet() be  //a context
//----------------------------------------------------------------------------
[
test Puts(telnetStr, Gets(telnetKeys))
   ifso BSPForceOutput(telnetSoc)
   ifnot Block() repeat  //stream closed
] repeat

//----------------------------------------------------------------------------
and NetToDsp() be  //a context
//----------------------------------------------------------------------------
[
let char = Gets(telnetStr)
if char eq -1 then
   test telnetSoc>>BSPSoc.markPending
      ifnot Block() repeat  //stream closed
      ifso switchon BSPGetMark(telnetSoc) into
         [
         case markSync: [ dataMark = dataMark-1; loop ]
         case markTiming: [ BSPPutMark(telnetSoc, markTimingReply); loop ]
         ]
if dataMark eq 0 then Puts(telnetDsp, char)
] repeat

//----------------------------------------------------------------------------
and TelnetInterrupt(pbi) be
//----------------------------------------------------------------------------
[
test pbi>>PBI.pup.type eq typeInterrupt
   ifso
      [
      dataMark = dataMark +1
      ReleasePBI(pbi)
      ]
   ifnot OtherPup(pbi)
]