%begin; ! PRINT: Print files on a nominated printer

! Adapted from EFTP
! Modified JHB  14/11/86 to put in a banner
! Modified FRED 28/11/86 to put large trailer on CITOH
! Modified JHB  22/06/87 in PRINT to delete ":"'s from hierarchic filenames
! Modified RWT  23/06/87 (provisionally to make the above "fix" work)

%include "inc:util.imp"
%include "inc:fs.imp"
%include "inc:fsutil.imp"
%constinteger bel=7

!Filename stuff

%constinteger maxnodes = 4
%conststring(7)%array nodename(1:maxnodes) = "Vax","Alpha","Bravo","Charlie"
%constintegerarray     nodenum(1:maxnodes) = 16_72,16_14,16_15,16_1B
%recordformat slotf(%integer portno,nodeno,userno)
%recordformat filef(%integer nodeno,xno,%record(slotf)%name slot,
                    %string(31)node,path,file,%record(filef)%name next)
%constinteger maxslot=3
%record(slotf)%array slot(1:maxslot)
%owninteger timeout = 15000 ;!Milliseconds - Ether timeout.
%ownstring (25) printdesc = "Machine Halls"

%constinteger mh = 0, op = 1, t26 = 2

%routine fail
  printsymbol(bel)
  %signal 15
%end

! Miscellaneous string operations

%predicate eq(%string(*)%name a,b)  {A full, B partial}
! True iff string B is a leading substring of A.
! Case not significant.
%integer i,m,n
  %falseunless length(a)>=length(b)
  %for i = 1,1,length(b) %cycle
    m = charno(a,i); n = charno(b,i)
    m = m!32 %and n = n!32 %if 'a'<=n!32<='z'
    %falseunless m=n
  %repeat
  %true
%end

%integerfn htoi(%string(*)%name s,%integername p)
! Return the integer value of the hex number, if any, starting at
! charno(P,S), advancing P past any digits actually processed.
%integer k,n = 0
  %cycle
    %result = n %if p>length(s)
    k = charno(s,p)
    k = k!32 %if 'A'<=k<='F'
    %if 'a'<=k<='f' %start
      k = k-'a'+10
    %elseif '0'<=k<='9'
      k = k-'0'
    %finishelseresult = n
    n = n<<4+k; p = p+1
  %repeat
%end

%string (255) %fn fullfilename(%record(filef)%name r)
  %string (255) s
  %if r_node="" %then s = "" %else s = substring(r_node, 1, 1)."::"
  s=s.r_path.r_file
  %result=s
%end

! Ether primitives

%predicate gotack(%integer port)
! Wait for ACK and return TRUE.
! Return FALSE if fed up waiting.
%integer bit,deadline,c
  bit = 1<<port
  %cycle
    deadline = cputime+timeout
    %cycle
      %if ack&bit#0 %start
        %trueif nak&bit=0
        nak = nak!!bit
        %false
      %finish
    %repeatuntil cputime>deadline
    prompt(" No response - shall I persevere?:")
    readsymbol(c) %until c&16_5f = 'N' %or c&16_5f = 'Y'
    %false %if c&16_5f = 'N'
    timeout = timeout*2
  %repeat
%end

%predicate gotdtx(%integer port)
! Wait for DTX and TRUE.  FALSE when fed up
%integer bit,deadline
  bit = 1<<port
  deadline = cputime+timeout
  %cycle
    %trueif dtx&bit#0
  %repeatuntil cputime>deadline
  %false
%end

%routine connect(%integer port,node)
! Establish a connection between local port PORT
! and network server NODE providing facility 2 (Filestore)
%string(127)reply
%integer i
%byte facility
{printstring("Attempting to connect port "); phex2(port)
{printstring(" to node "); phex2(node); newline
  facility = 2
  etheropen(port,node<<8)
  etherwrite(port,facility,1)
  %unless gotack(port) %start
    printstring("Node "); phex2(node)
    printstring(" not acknowledging connect request")
    etherclose(port)
    newline
    fail
  %finish
  %unless gotdtx(port) %start
    printstring("Node "); phex2(node)
    printstring(" not responding to connect request")
    etherclose(port)
    newline
    fail
  %finish
  length(reply) = etherread(port,charno(reply,1),127)
  i = charno(reply,length(reply))
  %unless i=nl %and length(reply)=2 %and charno(reply,1)>'0' %start
    printstring("Cannot connect to node "); phex2(node)
    printstring(": ".reply)
    etherclose(port)
    newline %unless i=nl
    fail
  %finish
  i = charno(reply,1)-'0'
  etheropen(port,node<<8+i)
{printstring("Local port "); phex2(port); printstring(" connected to node ")
{phex2(node); printstring(" port "); phex2(i); newline
%end

%routine disconnect(%record(slotf)%name s)
%byte eot = 12
  %onevent 15 %start
    %return
  %finish
  %returnif s_nodeno=-1
{printstring("Attempting to disconnect port "); phex2(s_portno)
{printstring(" from node "); phex2(s_nodeno); newline
  etherwrite(s_portno,eot,1)
  %if gotack(s_portno) %start
!!    printstring("Disconnected port "); phex2(s_portno)
!!    printstring(" from node "); phex2(s_nodeno)
  %else
    printstring("Cannot disconnect port "); phex2(s_portno)
    printstring(" from node "); phex2(s_nodeno)
    printstring(" - Nak")
    fail
  %finish
  etherclose(s_portno)
  s_nodeno = -1
%end

! Filestore primitives

%routine open(%integer mode,%record(filef)%name f, %integername size)
! Open a filestore file.  Mode should be 'S' for reading, 'T' for writing.
%record(slotf)%name s
%integer pos,pad
%string(127)cr
  s == f_slot
  cr = tostring(mode).tostring(s_userno+'0').f_path.f_file.tostring(nl)
  etherwrite(s_portno,charno(cr,1),length(cr))
  %unless gotack(s_portno) %start
    printline("Open: Nak")
    fail
  %finish
  %unless gotdtx(s_portno) %start
    printline("Open: no response")
    fail
  %finish
  length(cr) = etherread(s_portno,charno(cr,1),127)
  %unless length(cr)>0 %and charno(cr,1)>'0' %start
    printstring("Open: ".cr)
    newline %unless charno(cr,length(cr))=nl
    fail
  %finish
  pos = 1
  f_xno = hdx to i(cr, pos)
  %if mode = 'S' %start ;!Read
     size = hdx to i(cr, pos) ;!in blocks
     pad = hdx to i(cr, pos)
     size = size<<9 - pad ;!Bytes
  %finish
{phex2(f_xno); space; write(size, 5); space
%end

%routine close(%record(filef)%name f)
%record(slotf)%name s
%string(127)cr
  %onevent 15 %start
    %return
  %finish
  %returnif f_xno=0
  s == f_slot
  cr = "K".tostring(f_xno+'0').tostring(nl)
  etherwrite(s_portno,charno(cr,1),3)
  %unless gotack(s_portno) %start
    printline("Close: Nak")
    fail
  %finish
  %unless gotdtx(s_portno) %start
    printline("Close: no response")
    fail
  %finish
  length(cr) = etherread(s_portno,charno(cr,1),127)
  %unless cr=tostring(nl) %start
    printstring("Close: ".cr)
    newline %unless charno(cr,length(cr))=nl
  %finish
  f_xno = 0
%end

%integerfn readblock(%record(filef)%name f,%integer address)
%record(slotf)%name s
%string(3)c
%integer count,pos,size,char
  %onevent 15 %start
    %result = -1
  %finish
  s == f_slot
  c = "X".tostring(f_xno+'0').tostring(nl)
  etherwrite(s_portno,charno(c,1),3)
  %unless gotack(s_portno) %start
    printline("Readblock: Nak"); fail
  %finish
  %unless gotdtx(s_portno) %start
    printline("Readblock: Timeout"); fail
  %finish
  count = etherread(s_portno,byteinteger(address),999)
  pos = address; size = 0
  %if byteinteger(pos)<'0' %start
    printstring("Readblock: ")
    %cycle
      char = byteinteger(pos); pos = pos+1; printsymbol(char)
      count = count-1
    %repeatuntil char=nl %or count<=0
    newline %unless char=nl; fail
  %finish
  %cycle
    char = byteinteger(pos)-'0'; pos = pos+1
    %exitif char<0
    size = size<<4+char
  %repeat
  %unless size+pos-address=count %start
    printline("Readblock: dubious size"); fail
  %finish
  count = size
  %while count>0 %cycle
    count = count-1; byteinteger(address) = byteinteger(pos)
    address = address+1; pos = pos+1
  %repeat
  %result = size
%end

%predicate writeblock(%record(filef)%name f,%integer address,size)
%integer save1,save2
%record(slotf)%name s
%string(127)cr
  %onevent 15 %start
    %false
  %finish
  save1 = integer(address-4); save2 = integer(address-8)
  byteinteger(address-1) = nl
  byteinteger(address-2) = size&15+'0'
  byteinteger(address-3) = size>>4+'0'
  byteinteger(address-4) = f_xno+'0'
  byteinteger(address-5) = 'Y'
  s == f_slot
  etherwrite(s_portno,byteinteger(address-5),size+5)
  integer(address-4) = save1; integer(address-8) = save2
  %unless gotack(s_portno) %start
    printstring(" Writeblock: Nak"); %false
  %finish
  %unless gotdtx(s_portno) %start
    printstring(" Writeblock: Timeout"); %false
  %finish
  length(cr) = etherread(s_portno,charno(cr,1),127)
  %trueif cr = tostring(nl)
  printstring(" Writeblock: ".cr); newline %unless charno(cr,length(cr))=nl
  %false
%end

%constinteger banlines = 4
%routine readin(%record(filef)%name file,%integername start,len,%c
  %string (*) %name header,banner,trailer)
  %string (255) junk1,junk2
  %integer pos,dif,i,l,j

  %routine pack(%integer n)
     byteinteger(pos)=n; pos=pos+1; len=len+1
  %end

  %onevent 15 %start
    dispose(start) %if pos # 0; start = 0; len = -1; %return
  %finish

  len = 0; pos = 0
  open('S',file, len)
  !File + header + (banner+newline)*banlines + trailer + (2 newlines if banner)
  !+ maybe a terminating newline and a newpage after the banner
  l = len+length(header)+length(trailer)+banlines*(length(banner)+1)+2
  pos = heapget(l)
  start = pos; len = 0

  %for i=1,1,length(header) %cycle
     pack(charno(header,i))
  %repeat

  %if banner # "" %start
     %for i=1,1,banlines %cycle
        %for j=1,1,length(banner) %cycle
           pack(charno(banner,j))
        %repeat
        pack(nl)
     %repeat
     pack(nl); pack(nl)
     !If it's a .LIS file assume it is page-based and throw a newpage.
     pack(12) %and l=l+1 %if file_file -> junk1.(".lis")
  %finish

  %cycle
    dif = readblock(file,pos)
    %if dif<0 %start
      close(file); dispose(start); start = 0; len = -1; %return
    %finish
    pos = pos+dif
    len = len+dif
  %repeatuntil dif#512
  close(file)
  pack(nl) %if byteinteger(pos - 1) # NL;  !?
  %for i=1,1,length(trailer) %cycle
     pack(charno(trailer,i))
  %repeat

{phex(len); space
%end

%owninteger lastcpu = 0

%routine delay(%integer msec)
  !Wait till at least MSEC milliseconds since last delay
  %while cputime <= lastcpu+msec %cycle; %repeat
  lastcpu = cputime
%end


%predicate writeout(%record(filef)%name file,%integer pos,length)
  %onevent 15 %start
    %false
  %finish
  %false %unless length>0
  open('T',file, length)
  %while length>=512 %cycle
    delay(250)
    %false %unless writeblock(file,pos,512)
    pos = pos+512; length = length-512
  %repeat
  %unless length=0 %start
    %false %unless writeblock(file,pos,length)
  %finish
  close(file)
  %true
%end

%routine transfer(%record(filef)%name source,dest, %c
%string (255) header,banner,trailer)
! Copy one file
%integer ad,len
  %onevent 15 %start
    heapput(ad) %unless ad = 0; %return
  %finish
  ad = 0
  printstring(fullfilename(source)); space
  readin(source,ad,len,header,banner,trailer)
  %if len<0 %start
     printline("- failed to read it")
  %else
     printstring("- ")
     %if writeout(dest,ad,len) %start
        printline("Queued for ".printdesc." printer")
        heapput(ad)
     %else
        printline("Failed to write it")
     %finish
  %finish
%end

%routine processfilename(%record(filef)%name r)
%string(255)s,n,d,f
%record(slotf)%name sl
%integer i
  s = r_file
  %if length(s)>=2 %and substring(s,1,2)="::" %start
    s = substring(s,3,length(s))
    n = s %and s = "" %unless s -> n.(":").s
  %finishelse n = ""
  s = substring(s,2,length(s)) %if length(s)>=1 %and charno(s,1)=':'
  %if s -> d.("]").f %start
    d = d."]"
  %elseif s -> d.(":").f
    d = d.":"
  %else
    d = ""; f = s
  %finish
  r = 0
  r_node = n
  r_path = d
  r_file = f
  %unless n="" %start
    %for i = 1,1,maxnodes %cycle
      %if eq(nodename(i),n) %start
        r_node = nodename(i)
        r_nodeno = nodenum(i); ->ref
      %finish
    %repeat
    i = 1; r_nodeno = htoi(n,i)
    %if i<=length(n) %start
      printline("Unknown node `".n."`")
      r_node = ""
    %finish
  %finish
ref:
!Plug in the slot through which node R_NODENO may be referenced.
  %for i = 1,1,maxslot %cycle
    sl == slot(i)
    r_slot == sl %andreturnif sl_nodeno=r_nodeno
  %repeat
  %if r_nodeno=0 %start
    printline("Default node now meaningless"); fail
  %finish

  i = 1
  %cycle
    %if i>maxslot %start
      printline("No local port"); fail
    %finish
    sl == slot(i); %exitif sl_nodeno=-1
    i = i+1
  %repeat
  sl_nodeno = r_nodeno
  connect(i,r_nodeno)
  r_slot == sl
%end

%routine shutdown
%record(filef)%name reconnect
%record(slotf)%name s
%integer i
  %for i = 1,1,maxslot %cycle
    s == slot(i)
    %continueif s_nodeno=0
    disconnect(s)
  %repeat
%end

%routine initialise
%record(slotf)%name sl
%integer i
  %for i=1,1,maxslot %cycle
    sl == slot(i)
    sl_portno = i; sl_nodeno = -1; sl_userno = 0
  %repeat
  sl == slot(fsport)
  sl_nodeno = 0; sl_userno = userno
%end

%string(7)%function fsname(%integer a)
  %result = "A::" %if a = 16_14
  %result = "B::" %if a = 16_15
  %result = "C::" %if a = 16_1B
  %result = "MET::" %if a = 16_44
  %result = "VAX::" %if a = 16_72
  %result = ""
%end

%routine tart up(%string(*)%name text)
  %integer i, cap

  cap = 1
  %for i = 1, 1, length(text) %cycle
    %if 'a'<=charno(text, i)<='z' %start
      charno(text, i) = charno(text, i)-'a'+'A' %unless cap=0
      cap = 0
    %elseif 'A'<=charno(text, i)<='Z'
      charno(text, i) = charno(text, i)-'A'+'a' %if cap = 0
      cap = 0
    %else
      cap = 1
    %finish
  %repeat
%end

%routine process banner(%string(255) text, %string(*)%name dest,
                        %integer width, %integername nlines)

  %const %byte %integer %array strength(0:127) = %c
    255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,
    255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,
    255,63,7,31,31,31,31,7,15,15,31,31,63,31,63,127,
    1,1,1,1,1,1,1,1,1,1,127,127,31,31,31,63,
    31,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,15,31,15,31,3,
    7,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,15,31,15,31,255


  %integer i, j, k, l, cs, st, old length

  %routine blanks(%integer n)
    %integer i

    %return %if n<1
    dest = dest." " %for i = 1, 1, n
  %end

  j = 1
  %cycle
    old length = length(dest)
    j = j+1 %while j<=length(text) %and strength(charno(text, j)&127)>128
    %exit %if j>length(text)
    i = j+|width|-1
    %if i<length(text) %start
      l = i
      %unless strength(charno(text, i+1)&127)>128 %start
        st = 0
        %for k = i, -1, j+1 %cycle
          cs = strength(charno(text, k)&127)
          %exit %if st>128 %and cs<st
          %if cs<128 %and cs>st %start
             l = k
             st = cs
          %elseif cs>128 %and cs>=st
             l = k-1
             st = cs
          %finish
        %repeat
      %finish
    %else
      l = length(text)
    %finish
    blanks((j-width-l-1)//2) %if width<0
    dest = dest.substring(text, j, l)
    dest = dest.to string(nl) %unless length(dest)-old length=|width|
    nlines = nlines+1
    j = l+1
  %repeat
%end

%routine print(%string(255)file, %byteinteger printer, cpi, lpi, dq, banner)
   %conststring(1) %array cpitab(0:3) = " ","!","""","#"
   %conststring(1) %array lpitab(0:3) = " ","!","""","#"
   %conststring(1) %array dqtab (0:1) = " ",""""
   %record(filef)s,d
   %record(filef)%name list
   %string (255)curd,curu,header,trailer,banstring,junk1,junk2,fname
   %integer len, i

  %string (1) esc = tostring(16_1B)

   %string (31) %fn citoh(%integer cpi, lpi, dq)
     %string (31) s
     s = esc."?#".dqtab(dq)
     s = s.esc."?""".cpitab(cpi)
     s = s.esc."?!".lpitab(lpi)
     s = s."
"
     %result = s
  %end

  %string(9)%fn niceify(%string(255)s)
  %string(255)fore,aft
    s = fore.(".").aft %while s -> fore.(":").aft
    s = substring(s,length(s)-8,length(s)) %if length(s)>9
    %result = s
  %end

  header=""; trailer = ""; banstring=""
  s_file = file
  processfilename(s)
  curd = niceify(current directory)
  curu = niceify(current user)

  %if printer = op %start
     d_file = "::vax:dra3:[opspool]".curd
     printdesc = "Block O/P"
  %elseif printer = mh
     d_file = "::bravo:lp:!".curd
     printdesc = "Machine Halls"
     header  = citoh(cpi, lpi, dq)
     %if banner=1 %start
        len = 0
        trailer = ""
        process banner(datetime, trailer, -16, len)
!        process banner(current user, trailer, -16, len)
        process banner(fs name(rdte).curu, trailer, -16, len)
        fname = fullfilename(s)
        fname = curd.":".fname %unless fname -> junk1.(":")
        tart up(fname)
        process banner(fname, trailer, -16, len)
        trailer = trailer.esc."0 ".esc."1 ".citoh(1, 2, 0)
        trailer = to string(nl).trailer %for i = len, 1, 5
        trailer = to string(12).citoh(3, 2, 0).esc."0'".esc."1'". %c
                          "^^^^^^^^^^^^^^^^^^ the end of ^^".trailer
        banner = 0
     %else
        trailer = citoh(1, 2, 0)
     %finish
  %elseif printer = t26
     d_file = "::vax:dra3:[t26spool]".curd
     printdesc = "Corridor 26"
  %else
     printline("Unknown printer - printing to O/P")
     d_file = "::vax:dra3:[opspool]".current directory
     printdesc = "Block O/P"
  %finish

  %if d_file -> d_file.("_") %start;  %finish
  !VAX doesn't like usernumbers with subs
!!d_file = junk1.junk2 %while d_file -> junk1.(":").junk2
!!!Filestore "B" doesn't like hierarchic names with ":" s
  processfilename(d)

  %if banner = 1 %start ;! banner: Username, date, time
     banstring = "*** ".current directory
     banstring = banstring." " %while length(banstring) < %c
     54-length(fullfilename(s))
     banstring = banstring.fullfilename(s)."     ".date."  ".time." ***"
  %finishelse banstring = ""
  transfer(s,d,header,banstring,trailer)
%end


%routine do print(%string (255) thisbit)
  %string (255) p
  %byteinteger printer, cpi, lpi, dq, banner

  printer = mh; cpi=1; lpi=2; dq=0; banner=1
  define param("File -- File to be printed", p, pam nodefault)
! define enum param("MHprinter,OPprinter -- Machine Halls or Block O/P", printer, 0)
  define enum param("MH,OP,T26 -- Machine Halls, Block O/P, or Corridor 26",
                    printer, 0)
  define enum param("c10,c12,c13,c17 -- Characters per inch", cpi, 0)
  define enum param("DP,LQ -- Document quality", dq, 0)
  define enum param("l3,l4,l6,l8 -- Lines per inch", lpi, 0)
  define enum param("NUll,LIne,PAge -- Banner", banner, 0)
  process parameters(thisbit)
  print(p, printer, cpi, lpi, dq, banner)
  shutdown
%end

%routine main program
%ownstring(255) param = "",thisbit=""

  %onevent 0,3,9,15 %start
    %unless event_event=15 %start
      printline(" Aborted - ".event_message.itos(event_sub, 4))
      shutdown
    %finish
    %return
  %finish

  param = cliparam
  %while param -> thisbit.(",").param %cycle
     do print(thisbit)
  %repeat
  do print(param)
%end

initialise
main program

%endofprogram