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

! Adapted from EFTP

%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
%integer found,index,loop
%string(255) filename,directory
%constinteger maxfiles=500 { MAX of 500 files in a directory. (!) }
%string(255) %array(0:maxfiles) list

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

!-------------------------------------------------------------------------------

  %routine read files
  ! Find out what files in the named directory match the required filespec.
  ! Store these in an array with the directory name stuck on the front.
  
  %label cont
  %string(255) subject,in

    %on 9 %start
       selectinput(0)
       ->cont
    %finish

     index = 0
     %if filename->directory.("::") %then %start
       printline("Wildcards only work on the same filestore.")
       %stop
     %finish

     directory=current directory %unless filename->directory.(":").filename
     in=directory.":".filename
                        
     openinput(1,directory.":directory") { System file }
     selectinput(1)
     found = 0

     %cycle
     readline(subject)
     %if matches(subject,filename) %then %start { Add to array }
        found = 1                 { Got at least one file to match spec }
        list(index) = directory.":".subject
        index = index + 1
     %finish
     %repeat

     cont:
     %if found = 0 %start { This means no file was found to match an input }
                          { filespec. }
                          { Fail this attempt but continue with other files }
       printstring("No matches found for ".in)
       printsymbol(bel)
       newline
       selectinput(0)
     %finish
  %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

%routine printfilename(%record(filef)%name r)
  printstring("::".r_node.":") %unless r_node=""
  printstring(r_path.r_file)
%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

%routine readin(%record(filef)%name file,%integername start,len,%c
  %string (*) %name header,trailer)
  %integer pos,dif,i
  %onevent 15 %start
    dispose(start) %if pos # 0; start = 0; len = -1; %return
  %finish
  len = 0; pos = 0
  open('S',file, len)
  pos = heapget(len+length(header)+length(trailer))
  start = pos; len = 0
  %for i=1,1,length(header) %cycle
     byteinteger(pos)=charno(header,i); pos=pos+1
  %repeat
  len=len+length(header)

  %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)
  %for i=1,1,length(trailer) %cycle
     byteinteger(pos)=charno(trailer,i); pos=pos+1
  %repeat
  len=len+length(trailer)
{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,%string (255) header,trailer)
! Copy one file
%integer ad,len
  %onevent 15 %start
    heapput(ad) %unless ad = 0; %return
  %finish
  ad = 0
  printfilename(source); space
  readin(source,ad,len,header,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

%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) luser,header,trailer,banstring

  %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

  header=""; trailer = ""; banstring=""
  s_file = file
  processfilename(s)

  %if printer = op %start
     d_file = "::vax:dra3:[opspool]".current directory
     printdesc = "Block O/P"
  %elseif printer = mh
     d_file = "::bravo:lp:!".current directory
     printdesc = "Machine Halls"
     header  = citoh(cpi, lpi, dq)
     trailer = citoh(1,2,0)
  %elseif printer = t26
     d_file = "::vax:dra3:[t26spool]".current directory
     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
  processfilename(d)

  %if banner = 1 %start ;! one-line banner: Username, date, time
     banstring = "*** ".current directory."                          ".%c
     s_file."     ".date."  ".time." ***"
     header = header.tostring(nl).banstring.tostring(nl).tostring(nl)
  %finish
  transfer(s,d,header,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=0
  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)
  filename=p
  %if wildness(filename) =0 %then %start
    print(p ,printer, cpi, lpi, dq, banner)
    shutdown
  %finish %else %start
    readfiles { Get a list of all possible files to print. }
    %if found = 1 %start
      %for loop = 0,1,index-1 %cycle
        p=list(loop)
        print(p, printer, cpi, lpi, dq, banner)
        shutdown
      %repeat
    %finish
  %finish
%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
