home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / sigmv062.ark / KFORMAT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  5.3 KB  |  254 lines
  1. PROGRAM kformat;
  2. {
  3.  +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  4.  +                                   +
  5.  + PROGRAM TITLE:        FORMAT                   +
  6.  +                                   +
  7.  + WRITTEN BY:            K & F.                   +
  8.  +                                   +
  9.  +  Translated from the "format" program in the book           +
  10.  +  "Software Tools" by Kernigan & Flager               +
  11.  +                                   +
  12.  + MODIFICATION RECORD:                        +
  13.  +   MAR 81 - Pascal/Z v 3.3 and seperately compiled           +
  14.  +          modules by Raymond E. Penley, March 1981           +
  15.  +                                   +
  16.  +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  17. Zug Editor's comment: This is the MAIN module of a group of programs,
  18.     the following programs are needed:
  19.         KFORMAT.DOC
  20.         KFORMAT.SUB
  21.         KFORMAT.SYM
  22.         KFORMAT.TYP
  23.         STDIO.PAS
  24.         DOCOMM.PAS
  25.         DOTEXT.PAS
  26.         GLOBALS.TOP
  27.         STDFUNC.TOP
  28.     Each PAS progrm gets compiled. The main program must be compiled
  29. first because it makes the additional files *.sym and *typ. Each module
  30. may be edited and recompiled at any time. However, if any changes are 
  31. made in the MAIN module then ALL modules MUST be compiled again. At link
  32. time you should have:
  33.     LINK KFORMAT,STDIO,DOTEXT,DOCOMM
  34.  
  35. }
  36.  
  37. {$iGLOBALS.TOP }
  38.  
  39. {$iSTDFUNC.TOP }
  40.  
  41.  
  42. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  43. {+++ ALL I/O PROCEDURES ARE IN EXTERNAL FILE: STDIO.PAS +++}
  44. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  45.  
  46. PROCEDURE STDOPEN;EXTERNAL;
  47. PROCEDURE getc(var ch: char);EXTERNAL;
  48. PROCEDURE putc(c:CHAR);EXTERNAL;
  49. PROCEDURE puts(VAR LINE:BUFFER);EXTERNAL;
  50. PROCEDURE gets(VAR LINE:BUFFER);EXTERNAL;
  51.  
  52.  
  53. {
  54.   Skip chars in string
  55. }
  56. PROCEDURE SKIPCHARS(VAR buf: BUFFER; VAR ppos: int);
  57. begin
  58.   WHILE ( (buf[ppos]<>BLANK)
  59.       AND (buf[ppos]<>TAB)
  60.       AND (buf[ppos]<>newline) ) do ppos := ppos + 1;
  61. end;
  62.  
  63.  
  64. {
  65.   Skip blanks in string
  66. }
  67. PROCEDURE SKIPBL(VAR buf:BUFFER; VAR i: int);
  68. BEGIN
  69.   WHILE (buf[i]=BLANK) OR (buf[i]=TAB) DO i := i + 1;
  70. END;
  71.  
  72.  
  73. {$iIMINMAX.LIB }
  74.  
  75. {$iCTOITOC.LIB }
  76.  
  77.  
  78. {
  79.   Skip n blank lines
  80. }
  81. PROCEDURE SKIP(s: int);
  82. VAR    i: int;
  83. BEGIN
  84.   FOR i := 1 to s DO PUTC(newline);
  85. END;
  86.  
  87.  
  88. PROCEDURE PUTDEC(number,width: int);
  89. VAR    numstr    :DSTRING;
  90.     i,nd    : int;
  91. BEGIN
  92.   numstr := STR(number);
  93.   nd := length(numstr);
  94.   FOR i := (nd+1) TO width DO PUTC(SPACE);
  95.   FOR i := 1 to nd DO PUTC(numstr[i]);
  96. END;
  97.  
  98.  
  99. {
  100.   put out title line with optional page number
  101. }
  102. PROCEDURE PUTTL(VAR ttl:BUFFER; pagno: int);
  103. VAR    i: int;
  104. BEGIN
  105.   FOR i := 1 TO LENGTH(ttl) DO
  106.     IF (ttl[i]=PAGENUM)THEN
  107.       PUTDEC(pagno,1)
  108.     ELSE
  109.       PUTC(ttl[i]);
  110. END;
  111.  
  112.  
  113. {
  114.     put out page header
  115. }
  116. PROCEDURE PUTHEAD;
  117. BEGIN
  118.   curpag := newpag;
  119.   newpag := newpag + 1;
  120.   IF (m1val > 0) THEN
  121.     BEGIN
  122.       SKIP(m1val-1);
  123.       PUTTL(header,curpag)
  124.     END;
  125.   SKIP(m2val);
  126.   lineno := m1val + m2val + 1;
  127. END;
  128.  
  129.  
  130. {
  131.     put out page footer
  132. }
  133. PROCEDURE PUTFOOT;
  134. BEGIN
  135.   SKIP(m3val);
  136.   IF (m4val > 0) THEN
  137.     BEGIN
  138.       PUTTL(footer,curpag);
  139.       SKIP(m4val-1)
  140.     END;
  141.   lineno := 0;                { *** 3-24-81 *** }
  142. END;
  143.  
  144.  
  145. {
  146.     put out a line with proper spacing & indenting
  147. }
  148. PROCEDURE PUTTEXT(VAR ptline:BUFFER);
  149. VAR    i: int;
  150. BEGIN
  151.   IF ((lineno=0) OR (lineno > bottom)) THEN PUTHEAD;
  152.   FOR i := 1 to tival DO PUTC(SPACE);
  153.   tival := inval;
  154.   puts(ptline);
  155.   SKIP(IMIN(lsval-1,bottom-lineno));
  156.   lineno := lineno + lsval;
  157.   IF (lineno > bottom) THEN PUTFOOT;
  158. END;
  159.  
  160.  
  161. PROCEDURE DOBREAK;
  162. BEGIN
  163.   IF ( outp > 0 ) THEN
  164.     begin append(outbuf,newline);
  165.       PUTTEXT(outbuf);
  166.     end;
  167.   outp := 0;
  168.   outw := 0;
  169.   outwds := 0;
  170.   setlength(outbuf,0);        { * outbuf := ''; * }
  171. END;
  172.  
  173.  
  174. {++++++++++++++++++++++++++++++++++}
  175. {$R-}{ RANGE CHECKING OFF       }
  176. {$S-}{ STACK OVERFLOW CHECKING OFF }
  177. {++++++++++++++++++++++++++++++++++}
  178.  
  179.  
  180. PROCEDURE INITGLOBALS;
  181. BEGIN
  182.   EOS     := CHR(EOSVAL);
  183.   newline := EOS;        { *** 3-81 *** }
  184.   BACKSPACE := CHR(BACKSPVAL);
  185.   BLANK  := ' ';
  186.   TAB     := CHR(9);
  187.   spacefill := FALSE;
  188.   direction := FALSE;
  189.   fill     := TRUE;
  190.   lsval  := 1;
  191.   inval  := 0;
  192.   rmval  := PAGWIDDEF;
  193.   tival  := 0;
  194.   ceval  := 0;
  195.   ulval  := 0;
  196.   spval  := 0;
  197.   curpag := 0;
  198.   newpag := 1;
  199.   lineno := 0;
  200.   plval  := PAGLENDEF;
  201.   m1val  := HEMARGDEF;
  202.   m2val  := 2;
  203.   m3val  := 2;
  204.   m4val  := FOMARGDEF;
  205.   bottom := plval - m3val - m4val;
  206.   setlength(header,0);        { * header := ''; * }
  207.   setlength(footer,0);        { * footer := ''; * }
  208.   cmdlist[CMD0] := '  ';
  209.   cmdlist[ fi ] := 'fi';
  210.   cmdlist[ ce ] := 'ce';
  211.   cmdlist[ ul ] := 'ul';
  212.   cmdlist[ ls ] := 'ls';
  213.   cmdlist[ bp ] := 'bp';
  214.   cmdlist[ he ] := 'he';
  215.   cmdlist[ fo ] := 'fo';
  216.   cmdlist[ ind] := 'in'; { ind avoids conflict with keyword in }
  217.   cmdlist[ rm ] := 'rm';
  218.   cmdlist[ ti ] := 'ti';
  219.   cmdlist[ nf ] := 'nf';
  220.   cmdlist[ sp ] := 'sp';
  221.   cmdlist[ pl ] := 'pl';
  222.   cmdlist[ br ] := 'br';
  223.   cmdlist[ sf ] := 'sf';
  224.   cmdlist[UNKN] := 'zz';
  225.   outp := 0;
  226.   outw := 0;
  227.   outwds := 0;
  228. END;
  229.  
  230.  
  231. PROCEDURE DOCOMMAND(cmdline:buffer); EXTERNAL;
  232.  
  233.  
  234. PROCEDURE DOTEXT(textline:BUFFER); EXTERNAL;
  235.  
  236.  
  237. {
  238.     Main program kformat
  239. }
  240. BEGIN {$C+}{ allow control-c checking only in main program }
  241.   STDOPEN;
  242.   INITGLOBALS;
  243.   WHILE not eof(stdin) and not xeof do
  244.     BEGIN
  245.       gets(inbuf);
  246.       IF inbuf[1] = COMNDFLAG THEN
  247.     DOCOMMAND(inbuf)
  248.       ELSE
  249.     DOTEXT(inbuf);
  250.     END;
  251.   IF ( lineno>0 ) THEN DOCOMMAND('.sp 32000  ');
  252. END. {kformat}
  253.  
  254.