! 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