// 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 ]