home *** CD-ROM | disk | FTP | other *** search
/ Sound, Music & MIDI Collection 2 / SMMVOL2.bin / DOS / SS_PLAY / VTSRC12B.ZIP / DOC / MAKEDOC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-11-14  |  6.4 KB  |  317 lines
  1. PROGRAM MakeDoc;
  2.  
  3. USES Dos;
  4.  
  5.  
  6. CONST
  7.   MargenL = 8;
  8.   MargenR = 72;
  9.  
  10.  
  11.  
  12.  
  13. FUNCTION ReptStr(c: CHAR; n: INTEGER) : STRING;
  14.   VAR
  15.     i : WORD;
  16.   BEGIN
  17.     IF n > 255 THEN n := 255;
  18.     IF n < 0   THEN n := 0;
  19.     ReptStr[0] := CHAR(n);
  20.     FOR i := 1 TO n DO
  21.       ReptStr[i] := c;
  22.   END;
  23.  
  24.  
  25.  
  26.  
  27. PROCEDURE KillFinalSpaces(VAR s: STRING);
  28.   BEGIN
  29.     WHILE s[Length(s)] IN [' ', #9] DO DEC(s[0]);
  30.   END;
  31.  
  32.  
  33.  
  34.  
  35. PROCEDURE ConvertTabs(VAR s: STRING);
  36.   CONST
  37.     Sp : STRING[8] = '        ';
  38.   VAR
  39.     i : WORD;
  40.   BEGIN
  41.     REPEAT
  42.       i := Pos(#9, s);
  43.       IF i = 0 THEN EXIT;
  44.  
  45.       Sp[0] := CHAR(8 - ((i-1) MOD 8));
  46.  
  47.       s := Copy(s, 1, i-1) + Sp + Copy(s, i+1, 255);
  48.     UNTIL FALSE;
  49.   END;
  50.  
  51.  
  52.  
  53.  
  54. PROCEDURE Justificar(VAR s: STRING; w: WORD);
  55.   CONST
  56.     PrioChars = ['.', ',', '''', '!', '?', '¡', '¿', '-', ')', ']', '}', '"'];
  57.   VAR
  58.     SpPos    : ARRAY[1..100] OF WORD;
  59.     SpPrio   : ARRAY[1..100] OF BOOLEAN;
  60.     SpInsert : ARRAY[1..100] OF WORD;
  61.     i, j, n  : INTEGER;
  62.     target   : STRING;
  63.   LABEL
  64.     Ya;
  65.   BEGIN
  66.  
  67.     KillFinalSpaces(s);
  68.  
  69.     j := w - Length(s);
  70.     IF (j <= 0) OR (j = w) THEN EXIT;
  71.  
  72.     FillChar(SpPos,    SIZEOF(SpPos),    0);
  73.     FillChar(SpPrio,   SIZEOF(SpPrio),   0);
  74.     FillChar(SpInsert, SIZEOF(SpInsert), 0);
  75.  
  76.     n := 0;
  77.  
  78.     FOR i := 1 TO Length(s) DO
  79.       IF s[i] = ' ' THEN
  80.  
  81.         IF ( (i = 1)         OR (s[i-1] <> ' ') ) AND
  82.            ( (i = Length(s)) OR (s[i+1] <> ' ') ) THEN BEGIN
  83.  
  84.           INC(n);
  85.           SpPos[n] := i;
  86.  
  87.           IF ((i > 1)         AND (s[i-1] IN PrioChars)) OR
  88.              ((i < Length(s)) AND (s[i+1] IN PrioChars)) THEN BEGIN
  89.  
  90.              SpPrio[n] := TRUE;
  91.  
  92.           END;
  93.  
  94.         END;
  95.  
  96.     IF n = 0 THEN EXIT;
  97.  
  98.     WHILE j >= n DO BEGIN
  99.       FOR i := 1 TO n DO INC(SpInsert[i]);
  100.       DEC(j, n);
  101.     END;
  102.  
  103.     FOR i := 1 TO n DO BEGIN
  104.       IF j = 0 THEN GOTO Ya;
  105.       IF SpPrio[i] THEN BEGIN
  106.         INC(SpInsert[i]);
  107.         DEC(j);
  108.       END;
  109.     END;
  110.  
  111.     FOR i := 1 TO n DO BEGIN
  112.       IF j = 0 THEN GOTO Ya;
  113.       IF NOT SpPrio[i] THEN BEGIN
  114.         INC(SpInsert[i]);
  115.         DEC(j);
  116.       END;
  117.     END;
  118.  
  119. Ya:
  120.     Target := '';
  121.     j      := 1;
  122.  
  123.     FOR i := 1 TO n DO BEGIN
  124.       Target := Target + COPY(s, j, SpPos[i]-j) + ReptStr(' ', SpInsert[i] + 1);
  125.       j := SpPos[i] + 1;
  126.     END;
  127.  
  128.     s := Target + COPY(s, j, 255);
  129.  
  130.   END;
  131.  
  132.  
  133.  
  134. PROCEDURE ConvFile(fn : PathStr; VAR fo: TEXT);
  135.   CONST
  136.     StrMargenL : STRING[MargenL] = '                      ';
  137.   VAR
  138.     fi     : TEXT;
  139.     si, so : STRING;
  140.     i      : WORD;
  141.     mode   : (mdNormal, mdIndent, mdInd2nd);
  142.     Indent : WORD;
  143.     NLin   : WORD;
  144.  
  145.     PROCEDURE WriteSO;
  146.       BEGIN
  147.         IF so <> '' THEN BEGIN
  148.           IF mode = mdIndent THEN BEGIN
  149.             so[MargenL + 1]          := ' ';
  150.             so[MargenL + Indent - 2] := 'o';
  151.           END;
  152.           WriteLn(fo, so);
  153.         END;
  154.         so := '';
  155.         mode := mdNormal;
  156.       END;
  157.  
  158.   BEGIN
  159.  
  160.     fn := FExpand(fn);
  161.  
  162.     Assign (fi, fn);
  163.     Reset  (fi);
  164.  
  165.     so     := '';
  166.     mode   := mdNormal;
  167.     Indent := 7;
  168.     NLin   := 0;
  169.  
  170.     Write(#13'                                                                               ');
  171.  
  172.     WHILE NOT EoF(fi) DO BEGIN
  173.  
  174.       INC(NLin);
  175.       Write(#13, fn, ' (', NLin, ')');
  176.  
  177.       ReadLn(fi, si);
  178.       KillFinalSpaces(si);
  179.       ConvertTabs(si);
  180.  
  181.       IF Length(si) = 0 THEN BEGIN
  182.  
  183.         IF (so[MargenL + 1] = '*') AND (Indent > 2) THEN BEGIN
  184.           so[MargenL + 1]          := ' ';
  185.           so[MargenL + Indent - 2] := 'o';
  186.         END;
  187.  
  188.         WriteSO;
  189.  
  190.         mode := mdNormal;
  191.  
  192.         WriteLn(fo);
  193.  
  194.       END ELSE BEGIN
  195.  
  196.         IF si[1] > #175 THEN BEGIN
  197.  
  198.           WriteSO;
  199.  
  200.           WriteLn(fo, StrMargenL + si)
  201.  
  202.         END ELSE IF si[1] = '@' THEN BEGIN
  203.  
  204.           ConvFile(Copy(si, 2, 255), fo);
  205.  
  206.         END ELSE IF si = '-' THEN BEGIN
  207.  
  208.           WriteSO;
  209.  
  210.           WriteLn(fo, #12);
  211.  
  212.         END ELSE BEGIN
  213.  
  214.           IF ((si[1] = ' ') AND ((mode = mdIndent) OR (mode = mdInd2nd))) OR (si[1] = '*') THEN BEGIN
  215.  
  216.             IF si[1] = '*' THEN BEGIN
  217.               WriteSO;
  218.  
  219.               Indent := 2;
  220.               WHILE si[Indent] = ' ' DO INC(Indent);
  221.  
  222.               so := StrMargenL + '*' + ReptStr(' ', Indent - 3);
  223.  
  224.               mode := mdIndent;
  225.             END;
  226.  
  227.             so := so + ' ' + COPY(si, Indent, 255);
  228.  
  229.             WHILE Length(so) > MargenR DO BEGIN
  230.  
  231.               mode := mdInd2nd;
  232.  
  233.               i := MargenR;
  234.               WHILE (i > 0) AND (so[i] <> ' ') DO DEC(i);
  235.               IF i = 0 THEN i := MargenR;
  236.               si := Copy(so, i, 255);
  237.               so[0] := CHAR(i-1);
  238.               Justificar(so, MargenR);
  239.  
  240.               IF (so[MargenL + 1] = '*') AND (Indent > 2) THEN BEGIN
  241.                 so[MargenL + 1]          := ' ';
  242.                 so[MargenL + Indent - 2] := 'o';
  243.               END;
  244.  
  245.               WriteLn(fo, so);
  246.               KillFinalSpaces(si);
  247.               IF si <> '' THEN BEGIN
  248.                 WHILE si[1] = ' ' DO si := Copy(si, 2, 255);
  249.                 si := StrMargenL + ReptStr(' ', Indent - 1) + si;
  250.               END;
  251.               so := si;
  252.  
  253.             END;
  254.  
  255.           END ELSE BEGIN
  256.  
  257.             IF si[1] = ' ' THEN BEGIN
  258.               WriteSO;
  259.             END;
  260.  
  261.             IF so = '' THEN so := StrMargenL
  262.                        ELSE so := so + ' ';
  263.  
  264.             so := so + si;
  265.  
  266.             WHILE Length(so) > MargenR DO BEGIN
  267.  
  268.               i := MargenR;
  269.               WHILE (i > 0) AND (so[i] <> ' ') DO DEC(i);
  270.               IF i = 0 THEN i := MargenR;
  271.               si := Copy(so, i, 255);
  272.               so[0] := CHAR(i-1);
  273.               Justificar(so, MargenR);
  274.               WriteLn(fo, so);
  275.               KillFinalSpaces(si);
  276.               IF si <> '' THEN BEGIN
  277.                 WHILE si[1] = ' ' DO si := Copy(si, 2, 255);
  278.                 si := StrMargenL + si;
  279.               END;
  280.               so := si;
  281.  
  282.             END;
  283.  
  284.           END;
  285.  
  286.         END;
  287.  
  288.       END;
  289.  
  290.     END;
  291.  
  292.     Close(fi);
  293.  
  294.     WriteLn;
  295.  
  296.   END;
  297.  
  298.  
  299. VAR
  300.   fo : TEXT;
  301.  
  302. BEGIN
  303.  
  304.   WriteLn;
  305.   WriteLn('Formateador de textos de VangeliSTracker.');
  306.   WriteLn('(C) 1992 VangeliSTeam');
  307.   WriteLn;
  308.  
  309.   Assign (fo, ParamStr(2));
  310.   Rewrite(fo);
  311.  
  312.   ConvFile(ParamStr(1), fo);
  313.  
  314.   Close(fo);
  315.  
  316. END.
  317.