// CHATPARAMS.BCPL - Bob Sproull - Pup User Telnet - BCPL
// Copyright Xerox Corporation 1979, 1980
// modified: September 25, 1982  11:27 AM (E. Taft)

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

//outgoing procedures
external [
	ChatReadParams
	]

//incoming procedures
external [
	SetScreenColor
	OpenFile
	Closes
	Gets
	Endofs
	SetFilePos
	CallSwat
	Zero
	MoveBlock
	Ws
	Wns

//MDI
	LookupEntries

//GP
	SetupReadParam
	ReadParam

//SAVESTATE
	SaveState
	]

//incoming statics
external [
//CHAT
	bspVersion
	TTYVersion
	DisplayVersion
	makeBootFile

//OS
	fpUserCm
	fpSysDir
	dsp
	UserName
	UserPassword
	OsVersion
	]

//File-wide definitions
manifest nameLength=20		//Number of words in file name
manifest lDV=lFP+1


let ChatReadParams(parm) be
[

	Ws("*n*n*n*nChat of September 25, 1982.  ")
	Wns(dsp, bspVersion); Ws("P.")
	Wns(dsp, TTYVersion); Ws("T.");
	Wns(dsp, DisplayVersion); Ws("D.")

	if OsVersion ls 16 then CallSwat("OS version 16 or newer is required")

	Zero(parm, lPARM)
	MoveBlock(lv parm>>PARM.ConnectString,"Maxc",3)
	parm>>PARM.CalcScreenParms=true
	parm>>PARM.LineFeeds=true
	parm>>PARM.ControlChars = true
	parm>>PARM.tsTypeOut=true
	parm>>PARM.Ding=true
	parm>>PARM.Flash=true
	parm>>PARM.nRegions=4

	let names=vec nameLength*(1+maxNDisplayFonts)
	Zero(names, nameLength*(1+maxNDisplayFonts))

	ReadUserCM(parm, names)
	ReadCommandLine(parm, names)

// Save boot file if needed
	if makeBootFile then
		[
		@(lv parm>>PARM.ConnectString)=0
		@UserName=0
		@UserPassword=0
		SaveState("Chat.Boot", 0)
		return
		]

//Now do file name lookup on any of the stuff
	unless parm>>PARM.DisplayProtocol do parm>>PARM.nDisplayFonts = 0
	if parm>>PARM.nDisplayFonts eq 0 &
	   parm>>PARM.TypeScriptLength eq 0 then return

	if parm>>PARM.TypeScriptLength ne 0 then
		MoveBlock(names, lv parm>>PARM.TSFileName, nameLength)
	let fpv=vec lDV*(1+maxNDisplayFonts)
	let nmv=vec (1+maxNDisplayFonts)
	for i=0 to maxNDisplayFonts do nmv!i=names+i*nameLength

	let s=OpenFile("SysDir.",ksTypeReadOnly)
	LookupEntries(s, nmv, fpv, 1+parm>>PARM.nDisplayFonts, true)
	Closes(s)

//Move FP's into the parameter vector
	MoveBlock(lv parm>>PARM.TypeScriptFP, fpv+1, lFP)
	for i=1 to parm>>PARM.nDisplayFonts do
		[
		let sp=fpv+i*lDV
		if sp!0 eq 0 then CallSwat("Cannot find font file: ", nmv!i)
		MoveBlock((lv parm>>PARM.DisplayFontFP)+(i-1)*lFP, sp+1, lFP)
		]
]

and ReadUserCM(parm, names) be
[RUCM
let users=OpenFile("User.Cm", ksTypeReadOnly, charItem, verLatest, fpUserCm)
if users then [ let a=valof
   [					//Only process if there.
   let ScanVec=vec 128			//For holding goodies.
   let ScanID=ScanVec+3
   ScanVec!0=false
   ScanVec!1=users
   ScanVec!2=$*N
     [
     unless Scan(ScanID) then resultis nil	//End of file
     if StrEq(ScanID,"*N[CHAT]") then break
     ] repeat
     [						//Get command
     unless Scan(ScanID) then resultis nil	//EOF
     if ScanID>>STR.char↑2 eq $[ then break 	//Another subsystem
     test StrEq(ScanID,"*NFONT:") then
	[
	Scan(ScanID)				//Get font name
	MoveBlock(lv parm>>PARM.FontName,ScanID,size PARM.FontName/16)
	parm>>PARM.ScreenChars=ScanDefNum(ScanID,-1)
	parm>>PARM.ScreenLines=ScanDefNum(ScanID,-1)
	parm>>PARM.CalcScreenParms=(parm>>PARM.ScreenLines ls 0)
		%(parm>>PARM.ScreenChars ls 0)
	] or

     test StrEq(ScanID,"*NDISPLAY-REGIONS:") then
	[
	let r=ScanDefNum(ScanID,4)
	if r ls 2 then r=2
	parm>>PARM.nRegions=r
	] or

     test StrEq(ScanID,"*NDISPLAY-FONT:") then
	[
	let fn=parm>>PARM.nDisplayFonts+1
	if fn gr maxNDisplayFonts then
		[
		Ws("Too many fonts for Chat display protocol!")
		finish
		]
	let np=names+fn*nameLength
	Scan(ScanID)
	MoveBlock(np, ScanID, nameLength)
	parm>>PARM.nDisplayFonts=fn
	] or

     test StrEq(ScanID,"*NDISPLAY-YMAX:") then
	[
	parm>>PARM.YMax=ScanDefNum(ScanID, 0)
	] or

     test StrEq(ScanID,"*NBORDER:") then
	[
	Scan(ScanID)
	if StrEq(ScanID,"BLACK") then
	   [					//Set black
	   parm>>PARM.Border = 1
	   SetScreenColor(dsp, 1)
	   ]
	] or

     test StrEq(ScanID,"*NBELL:") then
	[
	   parm>>PARM.Ding=false
	   parm>>PARM.Flash=false
	   [
	   Scan(ScanID)
	   test StrEq(ScanID,"DING") then parm>>PARM.Ding=true or
	   test StrEq(ScanID,"FLASH") then parm>>PARM.Flash=true or
	   test StrEq(ScanID,"AUDIO") then parm>>PARM.Audio=true or
	    break
	   ] repeat
	   ScanID!-3=true
	] or

     test StrEq(ScanID,"*NCONNECT:") then
	[
	Scan(ScanID)
	MoveBlock(lv parm>>PARM.ConnectString,ScanID,size PARM.ConnectString/16)
	] or

     test StrEq(ScanID,"*NECHO:") then
	[
	Scan(ScanID)
	parm>>PARM.Echo=StrEq(ScanID,"ON")
	] or

     test StrEq(ScanID,"*NTYPESCRIPT:") then
	[
	Scan(ScanID)
	MoveBlock(lv parm>>PARM.TSFileName,ScanID,nameLength)
	parm>>PARM.TypeScriptLength=ScanDefNum(ScanID,-1)
	] or

     test StrEq(ScanID,"*NLINEFEEDS:") then
	[
	Scan(ScanID)
	parm>>PARM.LineFeeds=StrEq(ScanID,"ON")
	] or

     test StrEq(ScanID,"*NCONTROLCHARS:") then
	[
	Scan(ScanID)
	parm>>PARM.ControlChars=StrEq(ScanID,"ON")
	] or

     test StrEq(ScanID,"*NTYPESCRIPTCHARS:") then
	[
	Scan(ScanID)
	parm>>PARM.tsTypeIn=StrEq(ScanID,"ON")
	Scan(ScanID)
	parm>>PARM.tsTypeOut=StrEq(ScanID,"ON")
	] or

     test StrEq(ScanID,"*NDISPLAYPROTOCOL:") then
	[
	Scan(ScanID)
	parm>>PARM.DisplayProtocol=StrEq(ScanID,"ON")
	] or

     unless StrEq(ScanID,"*N") then
	[
	Ws("*NUnknown entry in User.Cm: "); Ws(ScanID);
	]
     ] repeat
   ]
   Closes(users)
]
]RUCM

//ScanDefNum(ScanID,default)
// Pick a number out of the stream:

and ScanDefNum(ScanID,def) = valof
[
   Scan(ScanID)		//Length
   let val=0
   for i=1 to ScanID>>STR.length do
   [
   let d=(ScanID>>STR.char↑i)-$0
   if d ls 0 % d gr 9 then 
	[
	ScanID!-3=true
	resultis def
	]
   val=val*10+d
   ]
   resultis val
]

//Scan(p) -- used to read USER.CM
// p!-2 is stream to use; p!-1 is left-over char.
// p!-3 if true means just return last ID
// Returns:
//	true if identifier found; ID in string p
//	false if at end of file

and Scan(p) = valof
[SC
if p!-3 then
	[
	p!-3=false
	resultis true
	]
let ch=p!-1		//Left over character
let ocnt=0		//Length of output string
let idgoing=false
   [
   let breakafter=false
   while ch eq 0 do
	[
	p!-1=0		//In case ENDOFS
	if Endofs(p!-2) then resultis idgoing
	ch=Gets(p!-2)
	]
   switchon ch into
	[
	case #40: case #11:
		if idgoing then break
		endcase
	case $: :
		breakafter=true
		endcase
	case $*N:
		if idgoing then break
	default:	idgoing=true
		endcase
	]
   if idgoing then
	[
	if ocnt gr 200 then break
	ocnt=ocnt+1
	p>>STR.length=ocnt
	p>>STR.char↑ocnt=ch
	]
   ch=0
   if breakafter then break
   ] repeat
p!-1=ch
resultis true		//Found an ID
]SC

//Read command line

and ReadCommandLine(parm, names) be
[RCL

let StringVec=vec 128
let SwitchVec=vec 28
SetupReadParam(StringVec,SwitchVec)

//Scan for global switches
for I=1 to SwitchVec!0 do
   switchon SwitchVec!I into
	[SwitchCases
	case $S: case $s:
		parm>>PARM.Server=true
		endcase
	case $A: case $a:
		parm>>PARM.MAXCForce=3
		endcase
	case $L: case $l:
		parm>>PARM.MAXCForce=2
		endcase
	case $N: case $n:
		parm>>PARM.MAXCForce=1
		endcase
	case $I: case $i:
		MoveBlock(lv parm>>PARM.DoFileName,"Chat.initial",size PARM.DoFileName/16)
		parm>>PARM.DoDirective=1
		endcase
	case $T: case $t:
		MoveBlock(lv parm>>PARM.TSFileName,"Chat.ts$",size PARM.TSFileName/16)
		parm>>PARM.TypeScriptLength = -1
		endcase
	case $E: case $e:
		parm>>PARM.Echo=true
		endcase
	case $C: case $c:
		parm>>PARM.ControlChars = false
		endcase
	case $D: case $d:
	case $P: case $p:
		parm>>PARM.DisplayProtocol=true
		endcase
	case $B: case $b:
		makeBootFile=true;
		endcase
	default: [Huh
		Ws("*NUnknown global switch.")
		endcase
		]Huh
	]SwitchCases

//Get local things and switches
while ReadParam($P,0,0,0,true) ne -1 do
   [
   if SwitchVec!0 eq 0 then SwitchVec!1=$C	//connect
   switchon SwitchVec!1 into
	[
	case $C: case $c:
		MoveBlock(lv parm>>PARM.ConnectString,StringVec,size PARM.ConnectString/16)
		endcase
	case $F: case $f:
		MoveBlock(lv parm>>PARM.FontName,StringVec,size PARM.FontName/16)
		endcase
	case $D: case $d:
		MoveBlock(lv parm>>PARM.DoFileName,StringVec,size PARM.DoFileName/16)
		parm>>PARM.DoDirective=1
		endcase
	case $E: case $e:
		MoveBlock(lv parm>>PARM.DoFileName,StringVec,size PARM.DoFileName/16)
		parm>>PARM.DoDirective=2
		endcase
	case $T: case $t:
		MoveBlock(lv parm>>PARM.TSFileName,StringVec,size PARM.TSFileName/16)
		parm>>PARM.TypeScriptLength = -1
		endcase
	default: Ws("*NUnknown local switch.")
	]
   ]

]RCL

and StrEq(a,b) = valof
[
if a>>STR.length ne b>>STR.length then resultis false
for i=1 to a>>STR.length do if a>>STR.char↑i ne b>>STR.char↑i
	then resultis false
resultis true
]