! 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