home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume3 / turbo_tools / part1 / chapter7.pas next >
Encoding:
Pascal/Delphi Source File  |  1986-11-30  |  8.4 KB  |  445 lines
  1. {chapter7.pas}
  2.  
  3. {
  4.         Copyright (c) 1981
  5.         By:     Bell Telephone Laboratories, Inc. and
  6.                 Whitesmith's Ltd.,
  7.  
  8.         This software is derived from the book
  9.                 "Software Tools in Pascal", by
  10.                 Brian W. Kernighan and P. J. Plauger
  11.                 Addison-Wesley, 1981
  12.                 ISBN 0-201-10342-7
  13.  
  14.         Right is hereby granted to freely distribute or duplicate this
  15.         software, providing distribution or duplication is not for profit
  16.         or other commercial gain and that this copyright notice remains
  17.         intact.
  18. }
  19.  
  20. PROCEDURE FORMAT;
  21. CONST
  22.   CMD=PERIOD;
  23.   PAGENUM=SHARP;
  24.   PAGEWIDTH=60;
  25.   PAGELEN=66;
  26.   HUGE=10000;
  27. TYPE
  28.   CMDTYPE=(BP,BR,CE,FI,FO,HE,IND,LS,NF,PL,
  29.     RM,SP,TI,UL,UNKNOWN);
  30. VAR
  31.   CURPAGE,NEWPAGE,LINENO:INTEGER;
  32.   PLVAL,M1VAL,M2VAL,M3VAL,M4VAL:INTEGER;
  33.   BOTTOM:INTEGER;
  34.   HEADER,FOOTER:XSTRING;
  35.   
  36.   FILL:BOOLEAN;
  37.   LSVAL,SPVAL,INVAL,RMVAL,TIVAL,CEVAL,ULVAL:INTEGER;
  38.  
  39.   OUTP,OUTW,OUTWDS:INTEGER;
  40.   OUTBUF:XSTRING;
  41.   DIR:0..1;
  42.   INBUF:XSTRING;
  43.   
  44. PROCEDURE SKIPBL(VAR S:XSTRING;VAR I:INTEGER);
  45. BEGIN
  46.   WHILE(S[I]=BLANK) OR(S[I]=TAB)DO
  47.     I:=I+1
  48.   END;
  49.   
  50. FUNCTION GETVAL(VAR BUF:XSTRING;VAR ARGTYPE:INTEGER):INTEGER;
  51. VAR
  52.   I:INTEGER;
  53. BEGIN
  54.   I:=1;
  55.   WHILE(NOT(BUF[I]IN[BLANK,TAB,NEWLINE]))DO
  56.     I:=I+1;
  57.   SKIPBL(BUF,I);
  58.   ARGTYPE:=BUF[I];
  59.   IF(ARGTYPE=PLUS) OR (ARGTYPE=MINUS) THEN
  60.     I:=I+1;
  61.   GETVAL:=CTOI(BUF,I)
  62. END;
  63.  
  64. PROCEDURE SETPARAM(VAR PARAM:INTEGER;VAL,ARGTYPE,DEFVAL,MINVAL,MAXVAL:
  65.   INTEGER);
  66. BEGIN
  67.   IF(ARGTYPE=NEWLINE)THEN
  68.     PARAM:=DEFVAL
  69.   ELSE IF (ARGTYPE=PLUS)THEN
  70.     PARAM:=PARAM+VAL
  71.   ELSE IF(ARGTYPE=MINUS) THEN
  72.     PARAM:=PARAM-VAL
  73.   ELSE PARAM:=VAL;
  74.   PARAM:=MIN(PARAM,MAXVAL);
  75.   PARAM:=MAX(PARAM,MINVAL)
  76. END;
  77.  
  78. PROCEDURE SKIP(N:INTEGER);
  79. VAR I:INTEGER;
  80. BEGIN
  81.   FOR I:=1 TO N DO
  82.     PUTC(NEWLINE)
  83. END;
  84.  
  85. PROCEDURE PUTTL(VAR BUF:XSTRING;PAGENO:INTEGER);
  86. VAR I:INTEGER;
  87. BEGIN
  88.   FOR I:=1 TO XLENGTH(BUF) DO
  89.     IF(BUF[I]=PAGENUM) THEN
  90.       PUTDEC(PAGENO,1)
  91.     ELSE
  92.       PUTC(BUF[I])
  93. END;
  94.  
  95. PROCEDURE PUTFOOT;
  96. BEGIN
  97.   SKIP(M3VAL);
  98.   IF(M4VAL>0) THEN BEGIN
  99.     PUTTL(FOOTER,CURPAGE);
  100.     SKIP(M4VAL-1)
  101.   END
  102. END;
  103.  
  104. PROCEDURE PUTHEAD;
  105. BEGIN
  106.   CURPAGE:=NEWPAGE;
  107.   NEWPAGE:=NEWPAGE+1;
  108.   IF(M1VAL>0)THEN BEGIN
  109.     SKIP(M1VAL-1);
  110.     PUTTL(HEADER,CURPAGE)
  111.   END;
  112.   SKIP(M2VAL);
  113.   LINENO:=M1VAL+M2VAL+1
  114. END;
  115.  
  116. PROCEDURE PUT(VAR BUF:XSTRING);
  117. VAR
  118.   I:INTEGER;
  119. BEGIN
  120.   IF(LINENO<=0) OR(LINENO>BOTTOM) THEN
  121.     PUTHEAD;
  122.   FOR I:=1 TO INVAL+TIVAL DO
  123.     PUTC(BLANK);
  124.   TIVAL:=0;
  125.   PUTSTR(BUF,STDOUT);
  126.   SKIP(MIN(LSVAL-1,BOTTOM-LINENO));
  127.   LINENO:=LINENO+LSVAL;
  128.   IF(LINENO>BOTTOM)THEN PUTFOOT
  129. END;
  130.  
  131.  
  132. PROCEDURE BREAK;
  133. BEGIN
  134.   IF(OUTP>0) THEN BEGIN
  135.     OUTBUF[OUTP]:=NEWLINE;
  136.     OUTBUF[OUTP+1]:=ENDSTR;
  137.     PUT(OUTBUF)
  138.   END;
  139.   OUTP:=0;
  140.   OUTW:=0;
  141.   OUTWDS:=0
  142. END;
  143.  
  144. FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;
  145.   VAR OUT:XSTRING):INTEGER;
  146. VAR
  147.   J:INTEGER;
  148. BEGIN
  149.   WHILE(S[I] IN [BLANK,TAB,NEWLINE]) DO
  150.     I:=I+1;
  151.   J:=1;
  152.   WHILE(NOT (S[I] IN [ENDSTR,BLANK,TAB,NEWLINE])) DO BEGIN
  153.     OUT[J]:=S[I];
  154.     I:=I+1;
  155.     J:=J+1
  156.   END;
  157.   OUT[J]:=ENDSTR;
  158.   IF(S[I]=ENDSTR) THEN
  159.     GETWORD:=0
  160.   ELSE
  161.     GETWORD:=I
  162. END;
  163.  
  164. PROCEDURE LEADBL(VAR BUF:XSTRING);
  165. VAR I,J:INTEGER;
  166. BEGIN
  167.   BREAK;
  168.   I:=1;
  169.   WHILE(BUF[I]=BLANK) DO
  170.     I:=I+1;
  171.   IF(BUF[I]<>NEWLINE) THEN
  172.     TIVAL:=TIVAL+I-1;
  173.   FOR J:=I TO XLENGTH(BUF)+1 DO
  174.     BUF[J-I+1]:=BUF[J]
  175. END;
  176.  
  177. PROCEDURE GETTL(VAR BUF,TTL:XSTRING);
  178. VAR
  179.   I:INTEGER;
  180. BEGIN
  181.   I:=1;
  182.   WHILE(NOT(BUF[I]IN[BLANK,TAB,NEWLINE]))DO
  183.     I:=I+1;
  184.   SKIPBL(BUF,I);
  185.   IF(BUF[I]=SQUOTE) OR(BUF[I]=DQUOTE)THEN
  186.     I:=I+1;
  187.   SCOPY(BUF,I,TTL,1)
  188. END;
  189.  
  190. PROCEDURE SPACE(N:INTEGER);
  191. BEGIN
  192.   BREAK;
  193.   IF (LINENO<=BOTTOM) THEN BEGIN
  194.     IF(LINENO<=0)THEN
  195.       PUTHEAD;
  196.     SKIP(MIN(N,BOTTOM+1-LINENO));
  197.     LINENO:=LINENO+N;
  198.     IF(LINENO>BOTTOM) THEN
  199.       PUTFOOT
  200.   END
  201. END;
  202.  
  203. PROCEDURE PAGE;
  204. BEGIN
  205.   BREAK;
  206.   IF(LINENO>0) AND (LINENO<=BOTTOM) THEN BEGIN
  207.     SKIP(BOTTOM+1-LINENO);putfoot
  208.   END;
  209.   LINENO:=0
  210. END;
  211.  
  212. FUNCTION WIDTH(VAR BUF:XSTRING):INTEGER;
  213. VAR
  214.   I,W:INTEGER;
  215. BEGIN
  216.   W:=0;
  217.   I:=1;
  218.   WHILE(BUF[I]<>ENDSTR) DO BEGIN
  219.     IF (BUF[I] = BACKSPACE) THEN
  220.       W:=W-1
  221.     ELSE IF (BUF[I]<>NEWLINE) THEN
  222.       W:=W+1;I:=I+1
  223.   END;
  224.   WIDTH:=W
  225. END;
  226.  
  227. PROCEDURE SPREAD(VAR BUF:XSTRING;
  228. OUTP,NEXTRA,OUTWDS:INTEGER);
  229. VAR
  230.   I,J,NB,NHOLES:INTEGER;
  231. BEGIN
  232.   IF(NEXTRA>0) AND (OUTWDS>1) THEN BEGIN
  233.     DIR:=1-DIR;
  234.     NHOLES:=OUTWDS-1;
  235.     I:=OUTP-1;
  236.     J:=MIN(MAXSTR-2,I+NEXTRA);
  237.     WHILE(I<J) DO BEGIN
  238.       BUF[J]:=BUF[I];
  239.       IF(BUF[I]=BLANK) THEN BEGIN
  240.         IF(DIR=0) THEN
  241.           NB:=(NEXTRA-1) DIV NHOLES +1
  242.         ELSE NB:=NEXTRA DIV NHOLES;
  243.         NEXTRA:=NEXTRA - NB;
  244.         NHOLES:=NHOLES-1;
  245.         WHILE(NB>0) DO BEGIN
  246.           J:=J-1;
  247.           BUF[J]:=BLANK;
  248.           NB:=NB-1
  249.         END
  250.       END;
  251.       I:=I-1;
  252.       J:=J-1
  253.     END
  254.   END
  255. END;
  256.  
  257. PROCEDURE PUTWORD(VAR WORDBUF:XSTRING);
  258. VAR
  259.   LAST,LLVAL,NEXTRA,W:INTEGER;
  260. BEGIN
  261.   W:=WIDTH(WORDBUF);
  262.   LAST:=XLENGTH(WORDBUF)+OUTP+1;
  263.   LLVAL:=RMVAL-TIVAL-INVAL;
  264.   IF(OUTP>0)
  265.     AND ((OUTW+W>LLVAL) OR (LAST >=MAXSTR)) THEN BEGIN
  266.       LAST:=LAST-OUTP;
  267.       NEXTRA:=LLVAL-OUTW+1;
  268.       IF(NEXTRA >0) AND(OUTWDS>1) THEN BEGIN
  269.         SPREAD(OUTBUF,OUTP,NEXTRA,OUTWDS);
  270.         OUTP:=OUTP+NEXTRA
  271.       END;
  272.       BREAK
  273.     END;
  274.     SCOPY(WORDBUF,1,OUTBUF,OUTP+1);
  275.     OUTP:=LAST;
  276.     OUTBUF[OUTP]:=BLANK;
  277.     OUTW:=OUTW+W+1;
  278.     OUTWDS:=OUTWDS+1
  279. END;
  280.  
  281. PROCEDURE CENTER(VAR BUF:XSTRING);
  282. BEGIN
  283.   TIVAL:=MAX((RMVAL+TIVAL-WIDTH(BUF)) DIV 2,0)
  284. END;
  285.  
  286. PROCEDURE UNDERLN (VAR BUF:XSTRING;SIZE:INTEGER);
  287. VAR
  288.   I,J:INTEGER;
  289.   TBUF:XSTRING;
  290. BEGIN
  291.   J:=1;
  292.   I:=1;
  293.   WHILE(BUF[I]<>NEWLINE) AND (J<SIZE-1)DO BEGIN
  294.     IF(ISALPHANUM(BUF[I])) THEN BEGIN
  295.       TBUF[J]:=UNDERLINE;
  296.       TBUF[J+1]:=BACKSPACE;
  297.       J:=J+2
  298.     END;
  299.     TBUF[J]:=BUF[I];
  300.     J:=J+1;
  301.     I:=I+1
  302.   END;
  303.   TBUF[J]:=NEWLINE;
  304.   TBUF[J+1]:=ENDSTR;
  305.   SCOPY(TBUF,1,BUF,1)
  306. END;
  307.  
  308. PROCEDURE TEXT(VAR INBUF:XSTRING);
  309. VAR
  310.   WORDBUF:XSTRING;
  311.   I:INTEGER;
  312. BEGIN
  313.   IF(INBUF[1]=BLANK) OR (INBUF[1]=NEWLINE) THEN
  314.     LEADBL(INBUF);
  315.   IF(ULVAL>0) THEN BEGIN
  316.     UNDERLN(INBUF,MAXSTR);
  317.     ULVAL:=ULVAL-1
  318.   END;
  319.   IF(CEVAL>0)THEN BEGIN
  320.     CENTER(INBUF);
  321.     PUT(INBUF);
  322.     CEVAL:=CEVAL-1
  323.   END
  324.   ELSE IF (INBUF[1]=NEWLINE)THEN
  325.     PUT(INBUF)
  326.   ELSE IF(NOT FILL) THEN
  327.     PUT(INBUF)
  328.   ELSE BEGIN
  329.     I:=1;
  330.     REPEAT
  331.       I:=GETWORD(INBUF,I,WORDBUF);
  332.       IF(I>0)THEN
  333.         PUTWORD(WORDBUF)
  334.       UNTIL(I=0)
  335.     END
  336.     
  337. END;
  338.   
  339.  
  340. PROCEDURE INITFMT;
  341. BEGIN
  342.   FILL:=TRUE;
  343.   DIR:=0;
  344.   INVAL:=0;
  345.   RMVAL:=PAGEWIDTH;
  346.   TIVAL:=0;
  347.   LSVAL:=1;
  348.   SPVAL:=0;
  349.   CEVAL:=0;
  350.   ULVAL:=0;
  351.   LINENO:=0;
  352.   CURPAGE:=0;
  353.   NEWPAGE:=1;
  354.   PLVAL:=PAGELEN;
  355.   M1VAL:=3;M2VAL:=2;M3VAL:=2;M4VAL:=3;
  356.   BOTTOM:=PLVAL-M3VAL-M4VAL;
  357.   HEADER[1]:=NEWLINE;
  358.   HEADER[2]:=ENDSTR;
  359.   FOOTER[1]:=NEWLINE;
  360.   FOOTER[2]:=ENDSTR;
  361.   OUTP:=0;
  362.   OUTW:=0;
  363.   OUTWDS:=0
  364. END;
  365.  
  366. FUNCTION GETCMD(VAR BUF:XSTRING):CMDTYPE;
  367. VAR
  368.   CMD:PACKED ARRAY[1..2] OF CHAR;
  369. BEGIN
  370.   CMD[1]:=CHR(BUF[2]);
  371.   CMD[2]:=CHR(BUF[3]);
  372.   IF(CMD='fi')THEN GETCMD:=FI
  373.   ELSE IF (CMD='nf')THEN GETCMD:=NF
  374.   ELSE IF (CMD='br')THEN GETCMD:=BR
  375.   ELSE IF (CMD='ls')THEN GETCMD:=LS
  376.   ELSE IF (CMD='bp')THEN GETCMD:=BP
  377.   ELSE IF (CMD='sp')THEN GETCMD:=SP
  378.   ELSE IF (CMD='in')THEN GETCMD:=IND
  379.   ELSE IF (CMD='rm')THEN GETCMD:=RM
  380.   ELSE IF (CMD='ce')THEN GETCMD:=CE
  381.   ELSE IF (CMD='ti')THEN GETCMD:=TI
  382.   ELSE IF (CMD='ul')THEN GETCMD:=UL
  383.   ELSE IF (CMD='he') THEN GETCMD:=HE
  384.   ELSE IF (CMD='fo') THEN GETCMD:=FO
  385.   ELSE IF (CMD='pl') THEN GETCMD:=PL
  386.   ELSE GETCMD:=UNKNOWN
  387. END;
  388.  
  389. PROCEDURE COMMAND(VAR BUF:XSTRING);
  390. VAR CMD:CMDTYPE;
  391. ARGTYPE,SPVAL,VAL:INTEGER;
  392. BEGIN
  393.   CMD:=GETCMD(BUF);
  394.   IF(CMD<>UNKNOWN)THEN
  395.     VAL:=GETVAL(BUF,ARGTYPE);
  396.     CASE CMD OF
  397.     FI:BEGIN
  398.        BREAK;
  399.        FILL:=TRUE END;
  400.     NF:BEGIN BREAK;
  401.        FILL:=FALSE END;
  402.     BR:BREAK;
  403.     LS:SETPARAM(LSVAL,VAL,ARGTYPE,1,1,HUGE);
  404.     CE:BEGIN BREAK;
  405.        SETPARAM(CEVAL,VAL,ARGTYPE,1,0,HUGE) END;
  406.     UL:SETPARAM(ULVAL,VAL,ARGTYPE,1,0,HUGE);
  407.     HE:GETTL(BUF,HEADER);
  408.     FO:GETTL(BUF,FOOTER);
  409.     BP:BEGIN PAGE;
  410.        SETPARAM(CURPAGE,VAL,ARGTYPE,CURPAGE+1,-HUGE,HUGE);
  411.        NEWPAGE:=CURPAGE END;
  412.     SP:BEGIN
  413.        SETPARAM(SPVAL,VAL,ARGTYPE,1,0,HUGE);
  414.        space(spval)
  415.        END;
  416.     IND:SETPARAM(INVAL,VAL,ARGTYPE,0,0,RMVAL-1);
  417.     RM:SETPARAM(INVAL,VAL,ARGTYPE,PAGEWIDTH,
  418.         INVAL+TIVAL+1,HUGE);
  419.     TI:BEGIN BREAK;
  420.        SETPARAM(TIVAL,VAL,ARGTYPE,0,-HUGE,RMVAL) END;
  421.     PL:BEGIN
  422.        SETPARAM(PLVAL,VAL,ARGTYPE,PAGELEN,
  423.         M1VAL+M2VAL+M3VAL+M4VAL+1,HUGE);
  424.        BOTTOM:=PLVAL-M3VAL-M4VAL END;
  425.     UNKNOWN:
  426.     END
  427.   END;
  428.  
  429.        
  430.        
  431.  
  432. BEGIN
  433.   
  434.   INITFMT;
  435.   WHILE(GETLINE(INBUF,STDIN,MAXSTR))DO
  436.     IF(INBUF[1]=CMD) THEN
  437.       COMMAND(INBUF)
  438.     ELSE
  439.       TEXT(INBUF);
  440.     PAGE
  441. END;
  442.  
  443.  
  444.  
  445.