// Copyright Xerox Corporation 1979 get "streams.d" // Outgoing procedures external [ SetupReadParam; ReadParam; EvalParam; ReadString; AddItem; Swat ] // Outgoing statics external [ ReadParamStream ] static [ ReadParamStream ] // Incoming procedures external [ Ws; Wss; Gets; Puts; dsp; keys; MoveBlock; OpenFile; Endofs; CallSwat; DefaultArgs ] external [ fpComCm //FP for file "Com.Cm" ] static [ stringVec; swVec ] structure STRING[ length byte char ^1,255 byte ] structure [ oddblank bit 15; odd bit ] structure [ left byte; right byte ] let SetupReadParam(aStringVec, aSwVec, aS, tempSwVec; numargs na) be [ let comName=vec 256 DefaultArgs(lv na) ReadParamStream=(aS ne 0 ? aS, OpenFile("Com.Cm", ksTypeReadOnly, charItem, 0, fpComCm)) stringVec=aStringVec; swVec=aSwVec ReadParam(0, 0, (stringVec ne 0 ? stringVec, comName), tempSwVec) ] and ReadParam(type, prompt, resultVec, aSwVec, returnOnNull; numargs na)=valof [ DefaultArgs(lv na) let name=vec 256; let sw=vec 128; let c=nil name!0=0; sw!0=0 let skipBlanks=true while true do [ c=GetComChar(skipBlanks) skipBlanks=false if c eq $/ % c eq $*S % c eq $*N then break AddItem(name, c) ] if c eq $/ then while true do [ c=GetComChar(false); if c eq $/ then loop if c eq $*S % c eq $*N then break if c eq $! then [ CallSwat("Debug break. "); loop ] AddItem(sw, c) ] if resultVec eq 0 & stringVec ne 0 then resultVec=stringVec if resultVec ne 0 then MoveBlock(resultVec, name, name!0+1) if aSwVec eq 0 & swVec ne 0 then aSwVec=swVec if aSwVec ne 0 then MoveBlock(aSwVec, sw, sw!0+1) if prompt eq -1 then [ returnOnNull=true; prompt=0 ] if returnOnNull & name!0 eq 0 resultis -1 resultis EvalParam(name, type, prompt, resultVec) ] and EvalParam(name, type, prompt, resultVec; numargs na)=valof [ // two-character types manifest [ ic=$I * #400 + $C; iw=$I * #400 + $W; oc=$O * #400 + $C; ow=$O * #400 + $W; ef=$E *#400 +$F ] structure SS[ length byte; c1 byte; c2 byte; blank byte ] let packedName=vec 128 let v=nil; let ft=nil; let radix=8 DefaultArgs(lv na, 2) if na ls 4 then resultVec=name if type gr 256 then [ test type>>SS.length eq 1 ifso type=type>>SS.c1 ifnot type=type>>SS.c1 * #400 + type>>SS.c2 ] if prompt eq 0 then prompt="Try again: " if name!0 eq 0 then goto GetNewName Retry: PackString(packedName, name) switchon type into [ case ic: case $I: ft=0 LOpenFile: v=0 if name!0 then v=OpenFile(packedName, (table [ ksTypeReadOnly; ksTypeReadOnly; ksTypeWriteOnly; ksTypeWriteOnly; ksTypeReadWrite; ksTypeReadWrite ] )!ft, ((ft eq 0%ft eq 2)? charItem,wordItem)) if v ne 0 then [ if resultVec ne 0 then goto RetPackedName endcase ] Ws("*NCouldn't open "); Ws(packedName) goto GetNewName case iw: ft=1; goto LOpenFile case oc: case $O: ft=2; goto LOpenFile case ow: ft=3; goto LOpenFile case $F: ft=4; goto LOpenFile case ef: ft=5; goto LOpenFile case $B: radix=8 GetNumber: [gn let e=name!0; let b=1 switchon name!e into [ case $d: case $D: radix=10; e=e-1; endcase case $o: case $O: case $b: case $B: radix=8; e=e-1; endcase default: endcase ] if name!b eq $# then [ radix=8; b=b+1 ] v=0 for i=b to e do [ let d=name!i-$0 if d ls 0 % d ge radix then [ Ws("*N"); Ws(packedName) Ws(" isn't a proper ") Ws((radix eq 8 ? "octal", "decimal")) Ws(" number") goto GetNewName ] v=v*radix+d ] ]gn endcase case $D: radix=10; goto GetNumber case $P: v=resultVec RetPackedName: test resultVec ne 0 ifso MoveBlock(resultVec, packedName, (name!0 rshift 1)+1) ifnot NoResultVec: CallSwat("No place to put the packed string") endcase case 0: v=resultVec test resultVec ne 0 ifso MoveBlock(resultVec, name, name!0+1) ifnot goto NoResultVec endcase default: CallSwat("Undefined type") ] resultis v GetNewName: Ws("*N"); Ws(prompt) ReadString(name, "/*S*N", keys, true, prompt) Puts(dsp, $*N); goto Retry ] and ReadString(result, breaks, inStream, editFlag, prompt; numargs na)=valof [ DefaultArgs(lv na, 1, "*N", keys, false, "") if inStream eq keys & (editFlag eq false % editFlag eq true) then editFlag=dsp // avoid using stsize or stdec let lb=breaks>>STRING.length let bv=vec 256 for i=1 to lb do [ let j=i rshift 1 bv!i=(i<>STRING.length=source!0 l6: for i=1 to source!0 do [ let j=i rshift 1 l7: test i<