// FtpKeys.bcpl
// Copyright Xerox Corporation 1979, 1980, 1982
// Last modified October 2, 1982  12:25 AM by Boggs

get "Streams.d"
get "SysDefs.d"
get "AltoDefs.d"

external
[
// outgoing procedures
CreateKeyStream; FlushKeyboard

// incoming procedures
Allocate; SetBlock; SysErr
InitRingBuffer; RingBufferEmpty
ReadRingBuffer; WriteRingBuffer; ResetRingBuffer
CharWidth; EraseBits; InvertWindow
SetTimer; TimerHasExpired; Enqueue
InitializeContext; Block; Dismiss
Gets; Puts; Endofs; Resets; Putbacks

// incoming statics
keys; sysZone; ctxQ; OsBuffer
]

static [ keyQ; cursorOn; cursorTimer; keyStream; dspPut ]

//-----------------------------------------------------------------------------------------
structure KeyS:		// Key Stream
//-----------------------------------------------------------------------------------------
[
@ST			// ST.par1 is used as a link
dspS word		// -> display stream
proc word
RBD word 4		// ring buffer descriptor
ringBuffer word		// ring buffer starts here
]
manifest lenKeyS = offset KeyS.ringBuffer/16
manifest lenRB = 50	// ring buffer length

//-----------------------------------------------------------------------------------------
let CreateKeyStream(proc, dspS) = valof
//-----------------------------------------------------------------------------------------
// Returns a key stream.  If proc returns true, characters
//  go into that stream's buffer until some other proc returns true.
[
let keyS = Allocate(sysZone, lenKeyS+lenRB)
SetBlock(keyS, SysErr, lST)
keyS>>KeyS.endof = KeyEndof
keyS>>KeyS.reset = KeyReset
keyS>>KeyS.gets = KeyGets
keyS>>KeyS.puts = KeyPuts
keyS>>KeyS.proc = proc
keyS>>KeyS.dspS = dspS
dspS>>ST.putback = dspS>>ST.puts
dspS>>ST.puts = PutsWithCursor
dspS>>ST.stateof = false  //last char was not ding
InitRingBuffer(lv keyS>>KeyS.RBD, lv keyS>>KeyS.ringBuffer, lenRB)
if keyQ eq 0 then
   [
   Enqueue(ctxQ, InitializeContext(Allocate(sysZone, 100), 100, KeyCtx))
   keyQ = Allocate(sysZone, 2); keyQ!0 = 0
   keyStream = keyS
   SetTimer(lv cursorTimer, 0)
   ]
Enqueue(keyQ, keyS)
resultis keyS
]

//-----------------------------------------------------------------------------------------
and KeyCtx(ctx) be
//-----------------------------------------------------------------------------------------
[
Block()
let ks = keyQ!0; while ks ne 0 do
   [
   if (ks>>KeyS.proc)() then
      [
      EraseCursor()
      keyStream = ks
      ]
   ks = ks!0
   ]
until Endofs(keys) do Puts(keyStream, Gets(keys))
] repeat

//-----------------------------------------------------------------------------------------
and KeyEndof(st) = valof
//-----------------------------------------------------------------------------------------
[
if st eq keyStream & TimerHasExpired(lv cursorTimer) then
   [
   SetTimer(lv cursorTimer, 50)
   test cursorOn
      ifso EraseCursor()
      ifnot [ Putbacks(keyStream>>KeyS.dspS, $|); cursorOn = true ]
   ]
resultis RingBufferEmpty(lv st>>KeyS.RBD)
]

//-----------------------------------------------------------------------------------------
and KeyReset(st) be ResetRingBuffer(lv st>>KeyS.RBD)
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and KeyPuts(st, char) be WriteRingBuffer(lv st>>KeyS.RBD, char)
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and KeyGets(st) = valof
//-----------------------------------------------------------------------------------------
[
Block() repeatwhile Endofs(st)
if st eq keyStream then EraseCursor()
st>>KeyS.dspS>>ST.stateof = false
resultis ReadRingBuffer(lv st>>KeyS.RBD)
]

//-----------------------------------------------------------------------------------------
and PutsWithCursor(st, char) be
//-----------------------------------------------------------------------------------------
[
if st eq keyStream>>KeyS.dspS then EraseCursor()
test char eq $*007  //bell
   ifso
      [
      unless st>>ST.stateof do
         [
         InvertWindow(st)
         Dismiss(50)
         InvertWindow(st)
         ]
      st>>ST.stateof = true  //last char was bell
      ]
   ifnot
      [
      Putbacks(st, char)
      st>>ST.stateof = false  //last char was not bell
      ]
]

//-----------------------------------------------------------------------------------------
and EraseCursor() be
//-----------------------------------------------------------------------------------------
if cursorOn then
   [
   let dspS = keyStream>>KeyS.dspS
   EraseBits(dspS, -CharWidth(dspS, $|))
   cursorOn = false
   ]

//-----------------------------------------------------------------------------------------
and FlushKeyboard() be
//-----------------------------------------------------------------------------------------
// Flushes the contents of the currently active keyboard buffer into
//  the OS keyboard buffer (to allow type-ahead when finishing)
[
let savedActive = @activeInterrupts; @activeInterrupts = 0
let rbd = lv keyStream>>KeyS.RBD
until Endofs(keys) do WriteRingBuffer(rbd, Gets(keys))
until RingBufferEmpty(rbd) do OsPuts(ReadRingBuffer(rbd))
@activeInterrupts = savedActive
]

//-----------------------------------------------------------------------------------------
and OsPuts(char) be
//-----------------------------------------------------------------------------------------
[
let newIn = OsBuffer>>OsBUF.In+1
if newIn eq OsBuffer>>OsBUF.Last then newIn = OsBuffer>>OsBUF.First
if newIn eq OsBuffer>>OsBUF.Out return  //full
@(OsBuffer>>OsBUF.In) = char
OsBuffer>>OsBUF.In = newIn
]