! COMPRESS utility: squeeze several columns into a single page.

%begin
%include "inc:util.imp"

%integer top=3      {blank lines at top of page}
%integer bot=3      {blank lines at bottom of page}
%integer page=66    {printing lines per page}
%integer cols=2     {number of columns}
%integer col=39     {printing chars per column}
%integer margin=2   {inter-column margin}
%integer left=0     {left-hand margin}
%integer wide

%constinteger   wrap=16_80000000  {over-long lines (ignore otherwise)}
%constinteger ignore=16_40000000  {discard spurious blank lines}

%integer bools=wrap+ignore
%string(255)fi,fo

  defineparam("Input file",fi,pamnodefault)
  defineparam("Output file",fo,pamnewgroup!pamnodefault)
  defineintparam("Top margin",top,0)
  defineintparam("Bot margin",bot,0)
  defineintparam("Left margin",left,0)
  defineintparam("Page size (lines per page)",page,0)
  defineintparam("Columns",cols,0)
  defineintparam("Width of each column",col,0)
  defineintparam("Margin between columns",margin,0)
  definebooleanparams("WRap,Ignore",bools,0)
  processparameters(cliparam)
  openinput(1,fi)
  openoutput(1,fo)
  wide = cols*col+margin*(cols-1)
  
%begin
%bytearray b(1:page,1:wide)
%integer xbase,x,y,nls,k

  %routine clear page
    %for y = 1,1,page %cycle
      b(y,x) = ' ' %for x = 1,1,wide
    %repeat
    xbase = 0; x = 1; y = 1
  %end

  %routine print page
  %owninteger blank = 0
  %integer i
    blank = blank+top
    %for y = 1,1,page %cycle
      i = wide; i = i-1 %while i>0 %and b(y,i)=' '; x = i
      %unless x=0 %start
        newlines(blank); blank = 0
        spaces(left); printsymbol(b(y,i)) %for i = 1,1,x
      %finish
      blank = blank+1
    %repeat
    blank = blank+bot
  %end

  %routine do(%integer k)
    %if k=nl %start
      nls = nls+1; %returnif nls>2 %and bools&ignore#0
      x = 1; y = y+1; %returnif y<=page
      y = 1; xbase = xbase+margin+col
      print page %and clear page %if xbase>wide
      %return
    %finish
    nls = 0
    %if k=9 %start
      x = x+1 %until x&7=1
    %elseif k=8
      x = x-1 %if x>1
    %elseif k=13
      x = 1
    %else
      %if x>col %start
        %returnif bools&wrap=0
        do(nl)
      %finish
      b(y,x+xbase) = k; x = x+1
    %finish
  %end
     
  %onevent 9 %start
    print page; newline; %stop
  %finish

  nls = 0
  clear page
  %cycle
    readsymbol(k); do(k)
  %repeat
%end
%end