home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol025 / pglst.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  2.1 KB  |  107 lines
  1. PROGRAM PGLST;
  2. {Format words compactly for printing.
  3.   Copyright 1979 by C. E. Duncan.
  4.   Revised 13:35 1980 December 15.}
  5. CONST
  6.     MCL = 80;    {MAXIMUM CHARACTERS PER LINE}
  7.     LPP = 60;    {LINES PER PAGE}
  8. TYPE
  9.     $STRING0 = STRING 0;
  10.     $STRING255 = STRING 255;
  11. VAR
  12.     LL: INTEGER;    {ITEM LENGTH}
  13.     NPL: INTEGER;    {ITEMS PER LINE}
  14.     X: INTEGER;        {COUNT ITEMS PROCESSED}
  15.     WRDFL: TEXT;    {INPUT FILE}
  16.     PRNFL: TEXT;    {OUTPUT PRINT FILE}
  17.     A: ARRAY[1..LPP] OF STRING 218;    {OUTPUT PAGE IMAGE}
  18. FUNCTION LENGTH(X:$STRING255):INTEGER; EXTERNAL;
  19. FUNCTION INDEX(X,Y:$STRING255):INTEGER; EXTERNAL;
  20. PROCEDURE SETLENGTH(VAR X:$STRING0; Y:INTEGER); EXTERNAL;
  21. PROCEDURE INIT;
  22. VAR
  23.     IFLN: STRING 14;    {INPUT FILE CP/M NAME}
  24.     OULN: STRING 14;    {OUTPUT FILE CP/M NAME}
  25. BEGIN
  26.     WRITE('Name of file to be listed: ');
  27.     READLN(IFLN);
  28.     WRITE('Output print file name: ');
  29.     READLN(OULN);
  30.     WRITE('Item length: ');
  31.     READLN(LL);
  32.     LL := LL + 2;
  33.     X := 0;
  34.     RESET(IFLN,WRDFL);
  35.     REWRITE(OULN,PRNFL);
  36.     NPL := (MCL + 2) DIV LL;    {ITEMS PER LINE}
  37.     LL := LL - 2
  38. END;    {INIT}
  39. PROCEDURE FILLPG;
  40. VAR
  41.     I,R,S,U,V,W: INTEGER;
  42.     WRD: STRING 218;
  43. BEGIN
  44.     FOR W := 1 TO LPP    {CLEAR ARRAY}
  45.     DO
  46.     SETLENGTH( A[W], 0 )
  47.     {OD};
  48.     V := 1;
  49.     WHILE (V <= NPL) AND (NOT EOF(WRDFL))
  50.     DO
  51.      BEGIN
  52.     S := (V-1)*(LL+2);
  53.     U := 1;
  54.     WHILE (U <= LPP) AND (NOT EOF(WRDFL))
  55.     DO
  56.         BEGIN
  57.         READLN(WRDFL,WRD);
  58.         X := X + 1;
  59.         IF V = 1
  60.         THEN
  61.         A[U] := WRD
  62.         ELSE
  63.           BEGIN
  64.         R := S - LENGTH(A[U]);
  65.         FOR I := 1 TO R
  66.         DO
  67.             APPEND(A[U],' ')
  68.         {OD};
  69.         APPEND(A[U],WRD)
  70.           END
  71.         {FI};
  72.         U := U + 1
  73.         END
  74.     {OD};
  75.     V := V + 1
  76.     END
  77.     {OD}
  78. END;    {FILLPG}
  79. PROCEDURE LSTPG;
  80. VAR
  81.     I: INTEGER;
  82. BEGIN
  83.     I := 1;
  84.     WHILE (I <= LPP)
  85.     DO
  86.     BEGIN
  87.     IF ( LENGTH ( A[I] ) <> 0 )
  88.     THEN
  89.         WRITELN(PRNFL,A[I])
  90.     {FI};
  91.     I := I + 1
  92.     END
  93.     {OD}
  94. END;    {LSTPG}
  95. BEGIN
  96.     INIT;
  97.     WHILE NOT EOF(WRDFL)
  98.     DO
  99.     BEGIN
  100.     FILLPG;
  101.     LSTPG
  102.     END
  103.     {OD};
  104.     WRITELN(PRNFL,X,' items.');
  105.     WRITELN(X,' items processed')
  106. END.
  107.