// CHATPARAMS.BCPL - Bob Sproull - Pup User Telnet - BCPL
// Copyright Xerox Corporation 1979, 1980
// modified: September 25, 1982 11:27 AM (E. Taft)
// modified: July 7, 1983 2:35 PM (T. Diebert)
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 July 7, 1983. ")
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,"*NPCMODE:") then
[
Scan(ScanID)
parm>>PARM.PCmode=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 $M: case $m:
parm>>PARM.PCmode = true
endcase
case $X: case $x:
parm>>PARM.LineFeeds = false
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
]