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