! PRINT {RWT, January 1991} adapted from the recently revised
! COPY program which automatically switches between filestores

option  "-low-nodiag-nocheck"
include  "inc:fs.imp"
include  "inc:util.imp"
include  "inc:fsutil.imp"

! Ether comms

routine  ackwait(integer  port)
integer  bit=1<<port,marktime=cputime+1000,deadline = marktime+14000
  cycle 
    returnif  ack&bit#0
    printsymbol('.') and  marktime=marktime+1000 if  cputime>marktime
  repeatuntil  cputime>deadline
  printline("No ACK/NAK"); signal  9
end 

routine  dtxwait(integer  port)
integer  bit=1<<port,marktime=cputime+1000,deadline=marktime+6500
  cycle 
    returnif  dtx&bit#0
    printsymbol('.') and  marktime=marktime+1000 if  cputime>marktime
  repeatuntil  cputime>deadline
  printline("No response"); signal  9
end 

predicate  nacked(integer  port)
integer  bit=1<<port
  falseif  nak&bit=0; nak = nak&¬bit; true 
end 

predicate  gotack(integer  port)
  on  9 start ; false ; finish 
  ackwait(port); falseif  nacked(port); true 
end 

predicate  gotdtx(integer  port)
  on  9 start ; false ; finish 
  dtxwait(port); true 
end 

! Filestore comms

routine  disconnect
byte  disc = {4}12
  returnif  rdte=0; rdte = 0; rsap = 0
  etherwrite(lsap,disc,1); ackwait(lsap); returnif  nacked(lsap)
end 

routine  connect
string (255)s
integer  port
byte  con = 2
  on  9 start 
    printline(event_message); return 
  finish 
  rsap = 0; fsport = lsap; etheropen(lsap,rdte<<8)
  etherwrite(lsap,con,1); ackwait(lsap)
  if  nacked(lsap) start 
    printstring("No Ack from station "); phex2(rdte); newline; return 
  finish 
  dtxwait(lsap)
  length(s) = etherread(lsap,charno(s,1),80)
  port = charno(s,1)-'0'
  if  port<0 start 
    printline(substring(s,3,length(s))); return 
  finish 
  etheropen(lsap,rdte<<8+port)
! check connection
  while  dtx&1#0 cycle 
    length(s) = etherread(0,charno(s,1),255)
    printline("Spurious port 0 packet ignored")
  repeat 
  s = "M0".snl; etherwrite(lsap,charno(s,1),3)
  unless  gotack(lsap) start 
    printline("No M0 ack"); return 
  finish 
  unless  gotdtx(lsap) start 
    printline("No M0 response"); return 
  finish 
  length(s) = etherread(lsap,charno(s,1),255)
  s = "G0".snl; etherwrite(lsap,charno(s,1),3)
  unless  gotack(lsap) start 
    printline("No G0 ack"); return 
  finish 
  unless  gotdtx(lsap) start 
    printline("No G0 response"); return 
  finish 
  length(s) = etherread(lsap,charno(s,1),255)
  while  charno(s,1)='-' cycle 
    printline("Ignoring duplicate response")
    unless  gotdtx(lsap) start 
      printline("No duplicate response"); return 
    finish 
    length(s) = etherread(lsap,charno(s,1),255)
  repeat 
  rsap = port
end 

begin 
recordformat  f(byte  ldte,lsap,rdte,rsap)
@#ldte record (f)cur
record (f)array  portinfo(1:31)
integer  original=cur_lsap,i,inport=original,outport=original

constinteger  lpi=1,cpi=2,qual=3
constinteger  lpinormal=2{6}, cpinormal=1{12}, qualnormal=0{draft}
byte  lpival=lpinormal,cpival=cpinormal,qualval=qualnormal,banner=1
string (255)thisone,therest,filename

routine  setparam(integer  parameter,value)
  printsymbol(27); printsymbol('?')
  printsymbol(parameter+' '); printsymbol(value+' ')
end 

routine  select(integer  port)
owninteger  uno=0
  uno = userno if  userno#0
  userno = 0
  userno = uno if  port=1
  cur = portinfo(port); fsport = port
end 

integerfn  allocate port
integer  i
  for  i = 1,1,31 cycle 
    if  portinfo(i)_rdte=rdte start 
      select(i)
      result  = i
    finish 
  repeat 
  for  i = 2,1,31 cycle 
    if  portinfo(i)_rdte=0 start 
      lsap = i; fsport = i
      connect; select(original) andresult  = 0 if  rsap=0
      portinfo(i) = cur
      result  = i
    finish 
  repeat 
  select(original); printline("No free local ports"); result  = 0
end 

integerfn  access(routine  open(integer  stream,string (255)filename),
                  string (255)filename)
! Result 0 after error report if failed, otherwise result is port number.
! Parse the filename to determine which filestore is meant, selecting the
! appropriate port, connecting if necessary.  Then open the file.  If this
! fails with "owner not found" (i.e. event_extra=12), and the filestore in
! question was B or C, then try instead on C or B.
ownbytearray  dtetable('A':'Z')=16_14,16_15,16_1B,0(*)
string (255)server,rawfilename
integer  dte,port,retried=0,k
  on  3 start 
    selectoutput(0); select(original)
    retried = 1 unless  event_extra=12
    if  retried=0 start 
      if  dte=dtetable('B') or  dte=dtetable('C') start 
        dte = dtetable('B')+dtetable('C')-dte
      finishelse  retried=1
    finish 
    if  retried#0 start 
      printline(event_message); result  = 0
    finish 
    retried = 1
  finish 
  select(original)
  if  retried=0 start   {first time parse filename}
    dte = rdte; rawfilename = filename
    if  filename -> server.("::").rawfilename start 
      retried = 1       {no retrying if server specified explicitly}
      k = charno(server,1)&95 unless  server=""
      if  length(server)=1 and  'A'<=k<='Z' start 
        dte = dtetable(k)
     else 
        dte = 0
        while  server#"" cycle 
          k = charno(server,1); server = substring(server,2,length(server))
          if  '0'<=k<='9' start 
            dte = dte<<4-'0'+k
          else 
            k = k&95; exitunless  'A'<=k<='F'
            dte = dte<<4-'A'+k+10
          finish 
        repeat 
      finish 
      if  dte=0 start 
no:     select(original); printstring("Unknown server ")
        printline(filename); result  = 0
      finish 
    finish 
  finish 
  rdte = dte; port = allocate port; ->no if  port=0
  select(port); open(1,rawfilename); selectoutput(0)
  result  = port
end 

routine  transfer
bytearray  buf(0:4095)
integer  n=0,k=nl,i
  on  9 start 
    closeinput
    select(outport); selectoutput(1)
    for  i = 0,1,n-1 cycle 
      k = buf(i); printsymbol(k)
    repeat 
    newline unless  k=nl
    selectoutput(0)
    return 
  finish 
  cycle 
    select(inport); selectinput(1)
    n = 0
    cycle 
      readsymbol(buf(n)); n = n+1
    repeatuntil  n=4096
    select(outport); selectoutput(1)
    for  i = 0,1,n-1 cycle 
      k = buf(i); printsymbol(k)
    repeat 
  repeat 
end 

! Draw box around text

constinteger  maxwidth=80,maxheight=71
string (maxwidth)array  line(1:maxheight)
integer  p=1,max=0

routine  newbox
  p = 1; max = 0
end 

routine  add(string (maxwidth)s)
! Add line S to the box
  returnif  p>maxheight-2 or  length(s)>=maxwidth-2
  max = length(s) if  length(s)>max
  line(p) = s; p = p+1
end 

routine  enbox(integer  margin)
! MARGIN is number of spaces wanted between text and horizontal border.
! For vertical equivalent, user is obliged to call ADD("") appropriately.
! For multiple borders, ENBOX may be called repeatedly.
integer  i
string (maxwidth)name  s
  returnif  p>maxheight-1 or  (1+margin)*2+max>=maxwidth
  for  i = p-1,-1,1 cycle 
    s == line(i+1)
    s = "|"
    s = s." " while  length(s)<=margin
    s = s.line(i)
    s = s." " while  length(s)<=2*margin+max
    s = s."|"
  repeat 
  s == line(1)
  s = "+"; s = s."-" while  length(s)<=2*margin+max
  s = s."+"
  line(p+1) = s
  p = p+2; max = (1+margin)*2+max
end 

routine  printbox(integer  pos)
! POS>0 aligns it to the left, with an extra POS-1 spaces.
! POS<0 aligns it to the right, (-POS)-1 spaces from the RH margin.
! POS=0 aligns it to the middle.
integer  i
  if  pos>0 then  pos = pos-1 -
  elseif  pos<0 then  pos = pos-max+maxwidth+1 -
  else  pos = (maxwidth-max)>>1
  for  i = 1,1,p-1 cycle 
    spaces(pos); printstring(line(i)); newline
  repeat 
end 

routine  print(string (255)file)
  inport = access(openinput,file); returnif  inport=0
  outport = access(openoutput,"c::lp:!".currentuser)
  if  outport=0 start 
    select(inport); selectinput(1); closeinput
    select(original); return 
  finish 
  printstring("Printing ".file); newline
  select(outport); selectoutput(1)
  setparam(lpi,lpival)
  setparam(cpi,cpival)
  setparam(qual,qualval)
  transfer
  selectoutput(1)
  setparam(lpi,lpinormal) unless  lpival=lpinormal
  setparam(cpi,cpinormal) unless  cpival=cpinormal
  setparam(qual,qualnormal) unless  qual=qualnormal
  unless  banner=0 start 
    printsymbol(12)

printstring("THIS SHOULD BE THE FIRST LINE ON THE PAGE"); newlines(3)
! 3 lines so far
newbox
add("IMPORTANT:")
add("Please check whether the top-of-form is set correctly, with the above")
add("'first line' appearing immediately adjacent to, but not overlapping,")
add("the inter-sheet perforations.  If it is wrong, PLEASE CORRECT IT NOW,")
add("as follows:")
add("* Raise the hood.")
add("* Raise the platen lever on your left.  This unlocks the tractor feed")
add("  mechanism, allowing you to adjust the paper alignment by rotating")
add("  the black knob on your right.")
add("* Move the paper until the inter-sheet perforations are in line with")
add("  the middle of the black plastic 'gates' which hold the paper to the")
add("  tractor feed mechanism.  A little 'nose' poking out of each of the")
add("  two gates marks the place.")
add("* Lower the platen lever to re-engage the motor drive.")
add("* NOW FOR THE CLEVER BIT:  While holding down the reset button, press")
add("  the form feed button once.  This is a special 'partial-form-feed'")
add("  instruction which tells the printer to advance the paper by the")
add("  difference between the sheet length and the distance from the")
add("  top-of-form position and the alignment 'noses'.")
add("* Lower the hood.  Press the on-line button.")
enbox(1); printbox(0)
! plus 20 plus 2 = 25 lines so far
newlines(50-25)
! 50 lines so far
newbox
select(original)
add(datetime)
add("The file just printed was ".file)
add("It was sent by ".currentuser)
select(outport)
enbox(1); enbox(1); enbox(1); printbox(0)

  finish 
  closeoutput; selectoutput(0)
end 

on  0 start 
  select(original); selectoutput(0); printstring("*Aborted")
  select(inport); select(original) if  inport=0
  selectinput(1); closeinput
  select(outport); select(original) if  outport=0
  selectoutput(1); resetoutput; closeoutput
  select(original); selectoutput(0); newline
  return 
finish 

  portinfo(i) = 0 for  i = 1,1,31
  portinfo(original) = cur
  
  therest = cliparam.","
  while  therest -> thisone.(",").therest cycle 
    filename = ""
    defineparam("File",filename,0)
    defineenumparam("c10,c12,c13,c17 - cpi",cpival,0)
    defineenumparam("l3,l4,l6,l8 - lpi",lpival,0)
    defineenumparam("draft,,letter - quality",qualval,0)
    defineenumparam("nobanner,banner - trailer",banner,0)
    processparameters(thisone)
    continueif  filename=""
    filename = currentdirectory.":".filename unless  filename -> (":")
    print(filename); select(original)
  repeat 

  for  i = 1,1,31 cycle 
    select(i); disconnect unless  i=original
  repeat 
  select(original)

end