// ChatTty1.bcpl -- overflow from ChatTty.bcpl
// Last modified October 19, 1980  2:51 PM by Taft
// Last modified July 7, 1983  2:53 PM by Diebert

get "Chat.d"
get "AltoDefs.d"
get "Streams.d"

external
[
// outgoing procedures
GetString; GetKey; FlipCaret; CaretOff; DirectKeys
ScreenBlack; ScreenWhite; SetScreenColor

// incoming procedures
SendMarkData
EraseBits; CharWidth; GetBitPos
SetTimer; TimerHasExpired; Block
Gets; Puts; Endofs; Zero; BitBlt; Min
Resets; Ws
EnqueueAudioOut

// incoming statics
caretDS; caretShown; keys; dsp; TTYSoc; Running; timingMarks; Parm; DIS
WasBlack
]

// Stuff for handling the keyboard nicely:

let GetString(p, echo, stopOnSpace, firstChar; numargs n) be
[
if n le 1 then echo=true
if n le 2 then stopOnSpace=false
if n le 3 then firstChar=0
let cnt=0
   [
   let c=nil
   test firstChar then [ c=firstChar; firstChar=0 ] or c=GetKey()
   if c eq #15 % (stopOnSpace ne 0 & c eq #40) then break
   test (c eq 1 % c eq #10 % c eq #177) then
	if cnt gr 0 then
		[
		if echo then EraseBits(dsp, -CharWidth(dsp, p>>STR.char↑cnt))
		cnt = cnt-1
		]
   or
	[
	if echo then Puts(dsp, c)
	cnt=cnt+1
	p>>STR.char↑cnt=c
	]
   ] repeat
p>>STR.length=cnt
]

//GetKey()
// Block until a keyboard character is struck.

and GetKey() = valof
[GK
let enteringDS = caretDS
let timer = nil
SetTimer(lv timer, 20)
let longTimer = nil
SetTimer(lv longTimer, 5*60*100)  // 5 minutes

	[ // repeat
	Block()
	if enteringDS ne caretDS loop
	if TimerHasExpired(lv timer) then
		[
		FlipCaret(caretDS)
		SetTimer(lv timer, (caretShown? 100, 20))
		]
	unless Endofs(keys) do
		[
		let c = Gets(keys)
		test c eq -1
			ifso while timingMarks gr 0 do
				[
				SendMarkData(TTYSoc, MarkTimingReply)
				timingMarks = timingMarks-1
				]
			ifnot [ CaretOff(); resultis c ]
		]
	// time out "Connect to:" state
	if enteringDS eq dsp & Running ne 1 &
	 TimerHasExpired(lv longTimer) then finish
	] repeat
]GK

and DirectKeys(ds) be [ CaretOff(); caretDS = ds ]

and CaretOff() be if caretShown then FlipCaret(caretDS)

and FlipCaret(ds) be
[
	caretShown = not caretShown
	let dcb = ds>>DS.cdcb
	let bbc = vec lBBC; bbc = (bbc+1)&-2
	Zero(bbc, lBBC)
	bbc>>BBC.Function = BBCInvert+BBSBitMap
	bbc>>BBC.DBCA = dcb>>DCB.bitmap
	bbc>>BBC.DBMR = dcb>>DCB.width
	bbc>>BBC.DLX = GetBitPos(ds)
	bbc>>BBC.DTY = 2*dcb>>DCB.height - 5
	bbc>>BBC.DW = Min(5, 16*dcb>>DCB.width-bbc>>BBC.DLX)
	bbc>>BBC.DH = 5
	bbc>>BBC.SBCA = table [ #20000; #70000; #50000; #154000; #104000 ]
	bbc>>BBC.SBMR = 1
	BitBlt(bbc)
]

//Call ScreenBlack() when bell is received...

and ScreenBlack() be
[Black
	if WasBlack then return
	WasBlack = true
	if Parm>>PARM.Ding then
	   [
	   Resets(dsp)
	   Ws(  "    $$$$$   $$$$   $$$  $$    $$$$$")
	   Ws("*N    $$  $$   $$    $$$$ $$   $$    ")
	   Ws("*N    $$  $$   $$    $$ $$$$   $$ $$$")
	   Ws("*N    $$  $$   $$    $$  $$$   $$  $$")
	   Ws("*N    $$$$$   $$$$   $$   $$    $$$$ ")
	   ]
	if Parm>>PARM.Flash then SetScreenColor(DIS, 1, true)
	if Parm>>PARM.Audio then EnqueueAudioOut(20, 200)
]Black

and ScreenWhite() be
[White
	unless WasBlack then return
	WasBlack = false
	if Parm>>PARM.Ding then
	   [ Resets(dsp); SetScreenColor(dsp, Parm>>PARM.Border) ]
	if Parm>>PARM.Flash then SetScreenColor(DIS, 0, true)
]White

and SetScreenColor(ds, color, lastOnly; numargs na) be
[
	let dcb = ds>>DS.fdcb
	while dcb ne ds>>DS.ldcb do
		[
		unless na ge 3 & lastOnly do dcb>>DCB.background = color
		dcb = dcb>>DCB.next
		]
	dcb>>DCB.background = color
]