!COMPARE: print differences between two files
%include "INC:UTIL.IMP";  !for parameter acquisition
%begin
%constinteger max=32, pmax=20
%constinteger wrap=31;  !** NB must be 2^k-1 and >= MAX-1
%constinteger linemax=95
%constinteger astream=1, bstream=2
%owninteger skip=1;  !to ignore blank lines
%recordformat info(%integer base,count,num,stream,blanks,
                   %string(255) filename,
                   %string(linemax)%array line(0:wrap))
%record(info) a,b
%owninteger misses=0, n

%routine print header(%record(info)%name r)
  print string("@Line");  write(r_base+r_blanks+1,1)
  print string(" in file ".r_filename)
  newline
%end

%routine print line(%record(info)%name r, %integer n)
  %if n > r_count %then print string(" **END**") %c
  %else print string(r_line((n+r_base)&wrap))
  newline
%end

%routine replenish(%record(info)%name r)
%integer i,j,k
%string(linemax)%name p
%on %event 9 %start
  %return
%finish
  select input(r_stream)
  %for i = max-r_num+1,1,max %cycle
    p == r_line((i+r_base)&wrap)
    %cycle
      read symbol(k)
      %exit %if k # nl %or skip = 0
      r_blanks = r_blanks+1
    %repeat
    p = ""
    %for j = 1,1,linemax %cycle
      %exit %if k = nl
      p = p.tostring(k)
      read symbol(k)
    %repeat
    r_count = r_count+1
  %repeat
%end

%predicate same(%integer al,bl)
  %if al > a_count %or bl > b_count %start
    %true %if al > a_count %and bl > b_count
    %false
  %finish
  %true %if a_line((al+a_base)&wrap) = b_line((bl+b_base)&wrap)
  %false
%end

%routine find match
%integer i,j
  a_num = -1
  %for i = 1,1,max %cycle
    %for j = 1,1,i %cycle
      %if same(i,j) %start
        %if i = j = 1 %or i = max %or j = max %or same(i+1,j+1) %start
          a_num = i;  b_num = j
          %return
        %finish
        a_num = i %and b_num = j %if a_num < 0
      %finish
      %if j # i %and same(j,i) %start
        %if i = max %or j = max %or same(j+1,i+1) %start
          a_num = j;  b_num = i
          %return
        %finish
        a_num = j %and b_num = i %if a_num < 0
      %finish
    %repeat
  %repeat
  a_num = max+1 %and b_num = max+1 %if a_num < 0
%end

%routine initialise
%ownstring(127)out=""
%on %event 3 %start  {Failure to open file}
  printstring(event_message);  newline
  %stop
%finish
  define param("First file",a_filename,pamnodefault)
  define param("Second file",b_filename,pamnodefault)
  define param("Result",out,pamnewgroup)
  process parameters(cliparam)
  openinput(1,a_filename)
  openinput(2,b_filename)
  %if out="" %then selectoutput(0) %elsestart
    openoutput(1,out); selectoutput(1)
  %finish
%end

  a_base = 0;  a_blanks = 0;  a_count = 0
  a_num = max;  a_stream = astream
  b_base = 0;  b_blanks = 0;  b_count = 0
  b_num = max;  b_stream = bstream
  initialise
  %cycle
    replenish(a)
    replenish(b)
    %exit %if a_count <= 0 %and b_count <= 0
    find match
    %if a_num # 1 %or b_num # 1 %start
      misses = misses+1
      %if a_num # 1 %start
        print header(a)
        n = 1
        %cycle
          space
          %if n = pmax-1 %and a_num > pmax %start
            print string(".....");  newline;  n = a_num-1
          %finish %else print line(a,n)
          n = n+1
        %repeat %until n = a_num
      %finish
      %if b_num # 1 %start
        print header(b)
        n = 1
        %cycle
          space
          %if n = pmax-1 %and b_num > pmax %start
            print string(".....");  newline;  n = b_num-1
          %finish %else print line(b,n)
          n = n+1
        %repeat %until n = b_num
      %finish
      %if b_num <= max %start
        print symbol('=')
        print line(b,b_num)
      %finish %else a_num = max %and b_num = max
      newline
    %finish
    a_base = a_base+a_num;  a_count = a_count-a_num
    b_base = b_base+b_num;  b_count = b_count-b_num
  %repeat
  select output(0)
  %if misses = 0 %then print string(" Files identical") %c
  %else %start
    write(misses,1);  print string(" mismatch")
    printstring("es") %if misses > 1
  %finish
  space;  printsymbol('(')
  a_base = a_base+a_blanks;  b_base = b_base+b_blanks
  write(a_base,0)
  print symbol('/') %and write(b_base,0) %if b_base # a_base
  print string(" lines)")
  newline
%endofprogram