home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols200 / vol280 / multcol.pas < prev    next >
Pascal/Delphi Source File  |  1986-06-11  |  6KB  |  221 lines
  1. program multcol;
  2. { converts a single column of text to multi-column output}
  3. {$iglobdefs.pas}
  4. {$istdutil.pas}
  5. {$istdio.pas}
  6. {$R+}
  7.  
  8. const
  9.      ncdefault      = 2;  { default number of columns }
  10.      csdefault      = 4;  { default space between columns }
  11.      cwdefault      = 38; { default column width }
  12.      lppdefault     = 56; { default lines per page }
  13.      ppdefault      = 66; { default physical page size }
  14.      PBSIZE         = 8000;  { size of page buffer (chars.) }
  15.      MAXLINES       = 80;    { max. no. of lines/page }
  16. var
  17.      gotfile,gotfile2 :boolean;
  18.      name,prompt    :textline;
  19.      infile,outfile :filedesc;
  20.      badinput       :boolean;
  21.      linesperpage,
  22.      colwidth,
  23.      colspace,
  24.      physpage,
  25.      numcols,
  26.      linewidth      :integer;
  27.  
  28. procedure getparams(var numcols,colwidth,colspace,linesperpage,linewidth:
  29.                     integer; var badinput:boolean);
  30. { get parameters from console}
  31.  
  32. var
  33.     prompt :textline;
  34.     maxbuf :integer;
  35.  
  36. procedure getnum(var prompt:textline;var x:integer;xdefault:integer);
  37. {get a number from the console}
  38.  
  39. var
  40.      gotline   :boolean;
  41.      numstring :textline;
  42.      i,junk    :integer;
  43.  
  44. begin
  45.      putstr(prompt,TRMOUT);
  46.      putc(LESS);
  47.      write(xdefault);
  48.      putc(GREATER);
  49.      putc(SPACE);
  50.      if getline(numstring,TRMIN,MAXSTR) then
  51.      begin
  52.           i:=1;
  53.           if skipsp(numstring,i) in [NEWLINE,EOS] then
  54.               x := xdefault
  55.           else x := ctoi(numstring,i);
  56.      end
  57.      else x := xdefault;
  58. end; { getnum }
  59.  
  60. begin { getparams }
  61.      setstring(prompt,'Number of columns? ');
  62.      getnum(prompt,numcols,ncdefault);
  63.      setstring(prompt,'Column width? ');
  64.      getnum(prompt,colwidth,cwdefault);
  65.      setstring(prompt,'Space between columns? ');
  66.      getnum(prompt,colspace,csdefault);
  67.      setstring(prompt,'Lines per page? ');
  68.      getnum(prompt,linesperpage,lppdefault);
  69.      setstring(prompt,'Physical page size (lines)? ');
  70.      getnum(prompt,physpage,ppdefault);
  71.      linewidth := (numcols*colwidth) + (numcols-1)*colspace;
  72.      maxbuf := linesperpage*(linewidth+1) + 5;
  73.      badinput := false;
  74.      if maxbuf>PBSIZE then
  75.      begin
  76.           writeln;
  77.           writeln('Not enough memory to store an output page.');
  78.           writeln;
  79.           badinput := true;
  80.      end;
  81.      if (linesperpage>MAXLINES) or (physpage>MAXLINES) then
  82.      begin
  83.           writeln;
  84.           writeln('Too many lines specified -- ',MAXLINES,' maximum.');
  85.           writeln;
  86.           badinput := true;
  87.      end;
  88. end; { getparams }
  89.  
  90. procedure convert(var infile,outfile:filedesc);
  91.  
  92. type
  93.      pagebuftype    = array[1..PBSIZE] of character;
  94.      cwarray        = array[1..MAXLINES] of integer;
  95. var
  96.      s              :textline;
  97.      pagebuf        :pagebuftype;
  98.      colswritten    :cwarray;
  99.      pagenum,
  100.      line,
  101.      column         :integer;
  102.  
  103. procedure initpage;
  104. { initialize page buffer }
  105.  
  106. var
  107.      i    :integer;
  108. begin
  109.      for i:=1 to PBSIZE do pagebuf[i] := SPACE;
  110.      for i:=1 to MAXLINES do colswritten[i] := 0;
  111. end;
  112.  
  113. procedure writeline(var s:textline;column,line:integer);
  114.  
  115. { write a line into the proper place on the page}
  116.  
  117. var
  118.      i,j  :integer;
  119.      eol  :boolean;
  120. begin
  121.      i := 1;
  122.      j := (linewidth+1)*(line-1) + 1 + (column-1)*(colwidth+colspace);
  123.      eol := false;
  124.      while (i<=colwidth) and (not eol) do
  125.      begin
  126.           eol := (s[i] = NEWLINE) or (s[i]=EOS);
  127.           if not eol then
  128.           begin
  129.                pagebuf[j] := s[i];
  130.                i := i + 1; j := j + 1;
  131.           end;
  132.      end;
  133.      colswritten[line] := colswritten[line] + 1;
  134. end; {writeline}
  135.  
  136. procedure writepage(var colswritten: cwarray);
  137. { write contents of page buffer to file }
  138.  
  139. var
  140.      i,j,k:integer;
  141.      c    :character;
  142.  
  143. begin
  144.      pagenum := pagenum + 1;
  145.      for i:=1 to linesperpage do
  146.      begin
  147.           j := (i-1)*(linewidth+1) + 1 + (colswritten[i]*colwidth);
  148.           if colswritten[i]>0 then j:=j+(colswritten[i]-1)*colspace;
  149.           pagebuf[j] := NEWLINE;
  150.      end;
  151.      for i:=1 to linesperpage do
  152.      begin
  153.           j := (i-1)*(linewidth+1)+1;
  154.           k := 0;
  155.           repeat
  156.                c := pagebuf[j];
  157.                {putc(c);}
  158.                putcf(c,outfile);
  159.                j := j + 1;
  160.                k := k + 1;
  161.           until (c=NEWLINE) or (k>linewidth);
  162.      end;
  163.      for i:=linesperpage+1 to physpage do putcf(NEWLINE,outfile);
  164. end; { writepage }
  165.  
  166. begin { convert }
  167.      column := 1; line := 1; pagenum := 0;
  168.      initpage;
  169.      while getline(s,infile,MAXSTR) do
  170.      begin
  171.           {putstr(s,TRMOUT);}
  172.           if (line>1) or (not (s[1] in [EOS,NEWLINE])) then
  173.           begin
  174.                writeline(s,column,line);
  175.                line := line + 1;
  176.           end;
  177.           if line > linesperpage then
  178.           begin
  179.                column := column + 1;
  180.                line := 1;
  181.                if column > numcols then
  182.                begin
  183.                     writepage(colswritten);
  184.                     initpage;
  185.                     column := 1;
  186.                end;
  187.           end;
  188.      end; { while }
  189.      if (line>1) or (column>1) then {output last partial page}
  190.           writepage(colswritten);
  191.      writeln; writeln(pagenum, ' page(s) written.'); writeln;
  192. end; { convert }
  193.  
  194. begin { main program }
  195.      lowvideo;
  196.      ioinit(2);
  197.      writeln;
  198.      writeln('This program converts a single-column input file to');
  199.      writeln('multi-column output.');
  200.      writeln;
  201.      writeln('by Jon Dart ... Version 1.3 (31-Mar-85)');
  202.      writeln;
  203.      repeat
  204.           setstring(prompt,'Input file name? ');
  205.           gotfile := getfile(infile,prompt,name,IOREAD);
  206.           if gotfile then
  207.           begin
  208.                setstring(prompt,'Output file name? ');
  209.                repeat
  210.                     gotfile2 := getfile(outfile,prompt,name,IOWRITE);
  211.                until gotfile2;
  212.                getparams(numcols,colwidth,colspace,linesperpage,linewidth,
  213.                          badinput);
  214.                if not badinput then
  215.                     convert(infile,outfile);
  216.                pclose(infile); pclose(outfile);
  217.           end;
  218.      until not gotfile;
  219. end.
  220.  
  221.