;<STROLLO>TOTELENET.BCPL;5 28-MAR-81 16:05:18 EDIT BY STROLLO
// <STROLLO>TOTELENET.BCPL;4 30-SEP-77 06:21:26 EDIT BY STROLLO
// TOTELENET.BCPL-- prog to send to
//<x-telenet>[--telenet-mail--].xy@xnet
get "sysdefs.d"
get "altofilesys.d"
get "streams.d"
manifest
[
maxnumsites = 20 // at most 20 sites - separated by ,
ctrlz = #32 // control Z
ctrlv = #26 // control V
cr = #15 // carriage return
space = #40
wordmax = 72
lf = #12 // line feed
]
external
[
OpenFile;Closes;FilePos;dsp;Puts;AppendChar;keys;Wss
sysZone;Allocate;Gets;FileLength;SetFilePos;Ws;Endofs
CallSubsys;fpComCm
]
static
[
charcount = 0
lastcr = false
]
structure [ SL byte; blank byte ]
structure CH ↑ 0, maxStringIndex byte
let main() be
[
// open file
let rawstream =
OpenFile("totelenet.raw",ksTypeReadOnly,charItem)
if rawstream eq 0 then
[
Ws("No raw text file - fatal error - get Swinehart")
return
]
// scan off destination sites
// position to first printing char past ":"
let rawpos = nil
let rawchar = nil
[ rawchar = Gets(rawstream) ]
repeatwhile rawchar ne $:
[ rawchar = Gets(rawstream) ]
repeatwhile rawchar eq space
SetFilePos(rawstream,0,FilePos(rawstream)-1)
// ready to get sites - 20 max, 1 min
let sitechar1,sitechar2,numsites = nil,nil,0
let sitevec = vec maxnumsites
let wordvec = vec wordmax // wordmax is max wordsize
for i = 0 to maxnumsites-1 do
[
sitechar1 = Gets(rawstream)
//Puts(dsp,sitechar1)
sitechar2 = Gets(rawstream)
//Puts(dsp,sitechar2)
sitevec!i = Allocate(sysZone,5)
let sitestring = sitevec!i
sitestring!0 = 0
AppendChar(sitechar1,sitestring)
AppendChar(sitechar2,sitestring)
numsites = i + 1
if Gets(rawstream) ne $, then break
]
// say the sites
Puts(dsp,$*n)
for i = 0 to numsites-1 do
[
let sitestr = sitevec!i
Ws(sitestr)
Puts(dsp,space)
]
// we are now at the char after the CR terminating site line
// create text file into which to put left alligned text
let totelestream =
OpenFile("totelenet.text",ksTypeWriteOnly,charItem)
if totelestream eq 0 then
[
Ws("Can't open file - get Swinehart")
return
]
// write text into file - skipping over trailer stuff
charcount = 0
wordvec>>SL = 0
let skipchar = nil
lastcr = false
[
rawchar = Gets(rawstream)
if rawchar eq cr then
[
StringtoFile(wordvec,totelestream)
PutCRLF(totelestream)
lastcr = true // permit intentional spaces after cr
loop
]
test rawchar eq ctrlz
ifso
[
[ skipchar = Gets(rawstream) ]
repeatwhile ((skipchar ne cr) &
(not Endofs(rawstream)))
SetFilePos(rawstream,0,FilePos(rawstream)-1) //to see CR again
]
ifnot
[
if rawchar ne space then lastcr = false // first non-space resets flag
test BreakChar(rawchar)
ifso
[
StringtoFile(wordvec,totelestream)
PutChkEOL(totelestream,rawchar)
]
ifnot
[
AppendChar(rawchar,wordvec)
if wordvec>>SL ge wordmax then
[
PutCRLF(totelestream)
StringtoFile(wordvec,totelestream)
PutCRLF(totelestream)
]
]
]
]
repeatwhile not Endofs(rawstream)
StringtoFile(wordvec,totelestream)
// close files
Closes(rawstream)
Closes(totelestream)
// create commands in temp command file
let tmpstream =
OpenFile("Com.cm", ksTypeWriteOnly, charItem, 0, fpComCm)
if tmpstream eq 0 then
[
Ws("Can't open Com.CM - get Swinehart")
return
]
Wss(tmpstream,"FTP.Run maxc2 ")
for i = 0 to numsites-1 do
[
Wss(tmpstream,"store/s ")
Wss(tmpstream,"totelenet.text ")
Wss(tmpstream,"<X-TELENET>[--TELENET-MAIL--].")
Wss(tmpstream,sitevec!i)
Puts(tmpstream,ctrlv)
Puts(tmpstream,$@)
Wss(tmpstream,"XNET")
Puts(tmpstream,space)
]
Puts(tmpstream,cr)
// close files
Closes(tmpstream)
// call FTP
let FTPstream =
OpenFile("FTP.RUN",ksTypeReadOnly)
if FTPstream eq 0 then
[
Ws("Can't open FTP.RUN - get Swinehart")
return
]
CallSubsys(FTPstream)
]
and PutCRLF(stream) be
[
// output CRLF, initialize counts
Puts(stream,cr)
Puts(stream,lf)
charcount=0
]
and PutChkEOL(stream,chr) be
[
if charcount ge 72 then
[
PutCRLF(stream)
if ((chr eq space)& not lastcr) then return
]
if ((charcount eq 0)&(chr eq space)&(not lastcr)) then return
Puts(stream,chr)
if ((chr ne $*177)&(chr ne lf)) then charcount = charcount + 1
if chr eq cr then charcount = 0
]
and StringtoFile(str,stream) be
[
// test to see if it will fit on current line
if (charcount + str>>SL) gr 72 then PutCRLF(stream)
for i = 1 to str>>SL do Puts(stream,str>>CH↑i)
charcount = charcount + str>>SL
str>>SL = 0
]
and BreakChar(chr) = valof
[
if chr le #43 then resultis true // all control,space,!,",# but not $
resultis selecton chr into
[
case $%: true
case $&: true
case $': false
case $**: true
case $+: true
case $,: false
case $-: true
case $.: false
case $/: true
case $=: true
case $@: true
case $\: true
case $↑: true
case $←: true
case $*140: true // accent grave (won't print for some reason)
case $|: true
case $~: true
case $*177: true
default: false
]
]