home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / UTILITY / PRINTER / LIST.ZIP / NLIST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-01-02  |  13.5 KB  |  519 lines
  1. PROGRAM NList;
  2.  
  3. {U+}
  4. {Epson MX80 printer controller ASCII file Print program}
  5. {Entered in the Public Domain by Nathan Liskov}
  6. {Adapted from Turbo Users Group Vol 1 Issue 3}
  7. {Can be invoked with filename as a parameter: nlist filename}
  8. {Feb 10, 1985}
  9.  
  10. TYPE 
  11.   DateTimeStr = STRING[26];
  12.   OnorOff     = ARRAY[1..2] OF STRING[3];
  13.   parmtype = STRING[127];
  14.   maxspaces = STRING[132];
  15.  
  16. VAR 
  17.     linecount, n, m, page, doublespace, linelength : integer;
  18.     topspaces, bottomspaces, leftmargin, rightmargin, lm, rm : integer;
  19.     option   : char;
  20.     pagestr  : STRING[3];
  21.     filename : STRING[45];
  22.     temp, lineout     : STRING[255];
  23.     right, left : maxspaces;
  24.     source   : text;
  25.     linemode, double, emphasized, header, automatic, maxline : integer;
  26.     x        : parmtype;
  27.     hellfreezesover : boolean;
  28.     datetimestamp: datetimestr;
  29.  
  30.   CONST 
  31.     onoff: onoroff = ('On ','Off');
  32.  
  33. PROCEDURE init;
  34.   BEGIN
  35.     linemode := 80;
  36.     write(lst,chr(18));        {set line mode to 80}
  37.     double   := 2;
  38.     write(lst,chr(27),chr(72)); {set double strike off}
  39.     emphasized := 2;
  40.     write(lst,chr(27),chr(70)); {set emphasized off}
  41.     header   := 1;           {default is header line on}
  42.     doublespace := 2;         {default is single spaces}
  43.     automatic := 2;          {default is zero margins}
  44.     topspaces := 1;
  45.     bottomspaces := 0;
  46.     leftmargin := 0;
  47.     rightmargin := 0;
  48.     right := '';
  49.     left := '';
  50.     IF paramcount<>0
  51.       THEN BEGIN
  52.              filename := paramstr(1);
  53.              assign(source,filename);
  54.           END
  55.       ELSE filename := '';
  56.     hellfreezesover := false;
  57.   END;
  58.  
  59. FUNCTION DateTime: DateTimeStr;
  60.  
  61. TYPE 
  62.   regpack = RECORD
  63.               ax,bx,cx,dx,bp,si,ds,es,flags: integer;
  64.             END;
  65.   dayname = STRING[3];
  66.  
  67.   TYPE monthname = ARRAY[1..12] OF STRING[3];
  68.  
  69.     CONST mon: monthname = ('Jan','Feb','Mar','Apr','May','Jun',
  70.                             'Jul','Aug','Sep','Oct','Nov','Dec');
  71.  
  72. VAR 
  73.   recpack:       regpack;                {record for MsDos call}
  74.   day,hours,minutes,seconds:     STRING[2];
  75.   year:          STRING[4];
  76.   month,dx,cx,daynumber,yearnumber:         integer;
  77.   dayoftheweek : dayname;
  78.  
  79. FUNCTION DayofWeek(juliandate:real): dayname;
  80. {finds day of week for 10 feb 1985 or later}
  81.  
  82. TYPE  daynames = ARRAY[1..7] OF STRING[3];
  83.  
  84.   CONST day: daynames = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
  85.  
  86. VAR   daynumber : real;
  87.  
  88. BEGIN
  89.   daynumber := (juliandate + 1.5)/7;
  90.   daynumber := daynumber -349444.0;   {sun 10 feb 1985}
  91.   WHILE daynumber > 32000 DO
  92.     daynumber := daynumber - 32000;
  93.   daynumber := (daynumber - trunc(daynumber))*7;
  94.   dayofweek := day[round(daynumber)+1];
  95. END;
  96.  
  97. FUNCTION juliandate(daynumber, monthnumber, yearnumber:integer): real;
  98.  
  99. VAR  a,b,c,d : real;
  100.  
  101. BEGIN
  102.   IF monthnumber < 3
  103.     THEN
  104.       BEGIN
  105.         yearnumber := yearnumber -1;
  106.         monthnumber := monthnumber + 12;
  107.       END;
  108.   a := trunc(yearnumber/100)*1.0;
  109.   b := 2-a+trunc(a/4)*1.0;
  110.   c := 365.0 * yearnumber+trunc(yearnumber/4);
  111.   d := trunc(30.6001*(monthnumber+1));
  112.   juliandate := b+c+d+1720994.5+daynumber;
  113. {  writeln('julian date ',b+c+d+1720994.5+daynumber:10:1);}
  114. END;
  115.  
  116. BEGIN
  117.   WITH recpack DO
  118.     BEGIN
  119.       ax := $2a shl 8;
  120.     END;
  121.   MsDos(recpack);                        { call function }
  122.   WITH recpack DO
  123.     BEGIN
  124.       str(cx,year);                        {convert to string}
  125.       yearnumber := cx;
  126.       daynumber := dx MOD 256;
  127.       str(daynumber,day);                     { " }
  128.       month := dx shr 8;
  129.     END;
  130.   WITH recpack DO
  131.     BEGIN
  132.       ax := $2c shl 8;
  133.     END;
  134.   MsDos(recpack);
  135.   WITH recpack DO
  136.     BEGIN
  137.       str(cx shr 8,hours);
  138.       IF (cx shr 8)<10
  139.         THEN hours := '0'+hours;
  140.       str(cx MOD 256,minutes);
  141.       IF (cx MOD 256)<10
  142.         THEN minutes := '0'+minutes;
  143.       str(dx shr 8,seconds);
  144.       IF (dx shr 8)<10
  145.         THEN seconds := '0'+seconds;
  146.     END;
  147.   dayoftheweek := (dayofweek(juliandate(daynumber,month,yearnumber)));
  148.   IF daynumber > 9
  149.     THEN
  150.       datetime := dayoftheweek+' '+day+' '+mon[month]+' '+year
  151.                   +'   '+hours+':'+minutes+':'+seconds
  152.     ELSE
  153.       datetime := dayoftheweek+' '+' '+day+' '+mon[month]+' '+year+'   '
  154.                   +hours+':'+minutes+':'+seconds;
  155. END;
  156.  
  157.  
  158. PROCEDURE optionline;
  159.   BEGIN
  160.     gotoxy(1,21);
  161.     normvideo;
  162.     writeln('   Enter Option Choice                                                ');
  163.     gotoxy(36,21);
  164.   END;
  165.  
  166. PROCEDURE menu;  {gives main menu options}
  167.   BEGIN
  168.     clrscr;
  169.     lowvideo;
  170.     writeln('Printer Utility for File Listing on MX-80');
  171.     writeln('____________By Nathan Liskov_____________');
  172.     writeln;
  173.     writeln('   0 := Form Feed');
  174.     writeln('   1 := Line Feed');
  175.     writeln('   2 := Characters/Line.         : ',linemode);
  176.     writeln('   3 := Double Strike            : ',onoff[double]);
  177.     writeln('   4 := Emphasized Mode          : ',onoff[emphasized]);
  178.     writeln('   5 := Header Line              : ',onoff[header]);
  179.     writeln('   6 := Double Spaced            : ',onoff[doublespace]);
  180.     writeln('   7 := Extra Top Blank Lines    : ',topspaces);
  181.     writeln('   8 := Extra Bottom Blank Lines : ',bottomspaces);
  182.     writeln('   9 := Automatic L/R Margins    : ',onoff[automatic]);
  183.     writeln('   L := Extra Left Margin        : ',leftmargin);
  184.     writeln('   R := Extra Right Margin       : ',rightmargin);
  185.     writeln;
  186.     normvideo;
  187.     writeln('   F := File Name                : ',filename);
  188.     writeln;
  189.     writeln('   G := GO         Q := QUIT');
  190.     writeln;
  191.     optionline;
  192.     page := 0;
  193.   END;
  194.  
  195. PROCEDURE get_file;
  196.   BEGIN
  197.     gotoxy(1,21);
  198.     write('   Enter name of file to list: ');
  199.     readln(filename);
  200.     assign(source,filename);
  201.     gotoxy(36,17);
  202.     write(filename,'                                           ');
  203.     optionline;
  204.   END;
  205.  
  206. PROCEDURE settopmargin;
  207.   BEGIN
  208.     gotoxy(1,21);
  209.     write('   Enter number of extra top spaces: ');
  210.     readln(topspaces);
  211.     gotoxy(36,11);
  212.     write(topspaces,'            ');
  213.     optionline;
  214.   END;
  215.  
  216. PROCEDURE setbottommargin;
  217.   BEGIN
  218.     gotoxy(1,21);
  219.     write('   Enter number of extra bottom spaces: ');
  220.     readln(bottomspaces);
  221.     gotoxy(36,12);
  222.     write(bottomspaces,'            ');
  223.     optionline;
  224.   END;
  225.  
  226. FUNCTION spaces(n:integer): maxspaces;
  227.  
  228.   VAR 
  229.     tmp: STRING[132];
  230.     m: integer;
  231.   BEGIN
  232.     tmp := '';
  233.     FOR m :=1 TO n DO
  234.       tmp := tmp + ' ';
  235.     spaces := tmp;
  236.   END;
  237.  
  238. PROCEDURE setleftmargin;
  239.   BEGIN
  240.     gotoxy(1,21);
  241.     write('   Enter number of extra left margin spaces: ');
  242.     readln(leftmargin);
  243.     left := spaces(leftmargin);
  244.     gotoxy(36,14);
  245.     write(leftmargin,'             ');
  246.     optionline;
  247.   END;
  248.  
  249. PROCEDURE setrightmargin;
  250.   BEGIN
  251.     gotoxy(1,21);
  252.     write('   Enter number of extra right margin spaces: ');
  253.     readln(rightmargin);
  254.     right := spaces(rightmargin);
  255.     gotoxy(36,15);
  256.     write(rightmargin,'             ');
  257.     optionline;
  258.   END;
  259.  
  260. PROCEDURE title; {prints filename, datetime, and page number on each page}
  261.   BEGIN
  262.     write(lst,chr(27),chr(45),chr(1));      {underline on}
  263.     IF linemode = 80
  264.       THEN
  265.         n := 21 - length(filename)
  266.       ELSE
  267.         n := 47 - length(filename);
  268.     temp := 'File: '+ filename;
  269.     FOR m:=1 TO n DO
  270.       temp := temp + chr(32);
  271.     temp := temp + datetimestamp;
  272.     IF linemode = 80
  273.       THEN
  274.         n := 19
  275.       ELSE
  276.         n := 45;
  277.     FOR m:=1 TO n DO
  278.       temp := temp + chr(32);
  279.     temp := temp + 'Page ';
  280.     str(page:3,pagestr);
  281.     temp := temp + pagestr;
  282.     writeln(lst,temp);
  283.     write(lst,chr(27),chr(45),chr(0));      {underline off}
  284.     write('.');
  285.     linecount := 2;
  286.   END;
  287.  
  288. PROCEDURE page_feed;
  289.   BEGIN
  290.     writeln(lst,chr(140));
  291.     linecount := 1;
  292.     page := page + 1;
  293.   END;
  294.  
  295. PROCEDURE insertblankline;
  296.   BEGIN
  297.     writeln(lst);
  298.     write('.');
  299.     linecount := linecount + 1;
  300.   END;
  301.  
  302. PROCEDURE inserttoplines;
  303.   BEGIN
  304.     FOR n := 1 TO topspaces DO
  305.       insertblankline;
  306.   END;
  307.  
  308. PROCEDURE composeline;       {inserts left and right margin spaces}
  309.   VAR
  310.     len : integer;
  311.   BEGIN
  312.     len := linemode
  313.      - leftmargin - rightmargin;
  314.     m := (length(temp)-1) DIV len + 1;
  315.    {number of sublines per line of input is m}
  316.     lineout := '';
  317.     FOR n := 1 TO m DO
  318.       lineout := lineout+left+ copy(temp,(n-1)*len+1,len) +right;
  319.     IF length(lineout) > 255
  320.       THEN BEGIN
  321.              writeln;
  322.              writeln('Warning....Line in excess of 255 characters in length.');
  323.         END;
  324.    END;
  325.  
  326. PROCEDURE automaticmargins;
  327. {sets margins so longest line in file is centered}
  328.   BEGIN
  329.     reset(source);
  330.     lm := leftmargin;
  331.     rm := rightmargin;
  332.     maxline := 0;
  333.     REPEAT
  334.       readln(source,temp);
  335.       m := length(temp);
  336.       IF m > maxline
  337.         THEN maxline := m;
  338.     UNTIL EOF(source);
  339.     close(source);
  340.     leftmargin := (linemode - maxline) DIV 2;
  341.     IF leftmargin < 0
  342.       THEN leftmargin := 0;
  343.     rightmargin := leftmargin;
  344.     right := spaces(rightmargin);
  345.     left := spaces(leftmargin);
  346.     END;
  347.  
  348. PROCEDURE printfile;
  349.   VAR
  350.       n : integer;
  351.   BEGIN
  352.     datetimestamp := datetime;
  353.     IF automatic = 1
  354.       THEN automaticmargins;
  355.     reset(source);
  356.     page := 1;
  357.     linecount := 1;
  358.     linelength := linemode -rightmargin-leftmargin;
  359.     IF linelength <= 0
  360.       THEN BEGIN
  361.              clrscr;
  362.              writeln('ERROR...Illegal margin size');
  363.              halt;
  364.         END;
  365.     writeln;
  366.     REPEAT
  367.       IF linecount =1
  368.         THEN BEGIN
  369.                writeln;
  370.                write('Page ',page,' ');              {status info to screen}
  371.                IF header = 1
  372.                  THEN title;
  373.                IF topspaces >0
  374.                  THEN inserttoplines;
  375.           END;
  376.       readln(source,temp);                   {read in one line}
  377.       composeline;
  378.       FOR n := 1 TO 1 + (length(lineout)-1) DIV linemode do
  379.         BEGIN
  380.           temp := copy(lineout,(n-1)*linemode+1,linemode);
  381.           writeln(lst,temp);                     {write out one line}
  382.           write('.');
  383.           linecount := linecount + 1;
  384.           IF doublespace = 1
  385.             THEN insertblankline;
  386.           IF linecount > 59 - bottomspaces
  387.             THEN page_feed;
  388.           IF linecount =1
  389.             THEN BEGIN {do header if page ends on a long line}
  390.                    writeln;
  391.                    write('Page ',page,' ');         {status info to screen}
  392.                    IF header = 1
  393.                      THEN title;
  394.                    IF topspaces >0
  395.                      THEN inserttoplines;
  396.               END;
  397.         END;
  398.     UNTIL eof(source);
  399.     close(source);
  400.     IF automatic = 1      {restore margin values}
  401.       THEN BEGIN
  402.              leftmargin := lm;
  403.              left := spaces(leftmargin);
  404.              rightmargin := rm;
  405.              right := spaces(rightmargin);
  406.         END;
  407.     menu;
  408.   END;
  409.  
  410. PROCEDURE quit;       {restores default conditions on printer}
  411.   BEGIN
  412.     write(lst,chr(18));     {80 char/line}
  413.     write(lst,chr(27),chr(72));  {double strike off}
  414.     clrscr;
  415.     halt;
  416.   END;
  417.  
  418. PROCEDURE action;
  419.   BEGIN
  420.     CASE option OF
  421.       '0': write(lst,chr(140));
  422.       '1': write(lst,chr(138));
  423.       '2': BEGIN
  424.              IF linemode=80
  425.                THEN BEGIN
  426.                       linemode := 132;
  427.                       write(lst,chr(15));
  428.                  END
  429.                ELSE BEGIN
  430.                       linemode := 80;
  431.                       write(lst,chr(18));
  432.                  END;
  433.              gotoxy(36,6);
  434.              write(linemode,'      ');
  435.              optionline;
  436.            END;
  437.       '3': BEGIN
  438.              IF double = 1
  439.                THEN BEGIN
  440.                       double := 2;
  441.                       write(lst,chr(27),chr(72));  {put double strike off}
  442.                  END
  443.                ELSE BEGIN
  444.                       double := 1;
  445.                       write(lst,chr(27),chr(71));  {double strike on}
  446.                  END;
  447.              gotoxy(36,7);
  448.              write(onoff[double],'    ');
  449.              optionline;
  450.            END;
  451.       '4': BEGIN
  452.              IF emphasized = 1
  453.                THEN BEGIN
  454.                       emphasized := 2;
  455.                       write(lst,chr(27),chr(70));  {emphasized off}
  456.                  END
  457.                ELSE BEGIN
  458.                       emphasized := 1;
  459.                       write(lst,chr(27),chr(71));  {emphasized on}
  460.                  END;
  461.              gotoxy(36,8);
  462.              write(onoff[emphasized],'    ');
  463.              optionline;
  464.            END;
  465.       '5': BEGIN
  466.              IF header=1
  467.                THEN header := 2
  468.                ELSE header := 1;
  469.              gotoxy(36,9);
  470.              write(onoff[header],'      ');
  471.              optionline;
  472.            END;
  473.       '6': BEGIN
  474.              IF doublespace=1
  475.                THEN doublespace := 2
  476.                ELSE doublespace := 1;
  477.              gotoxy(36,10);
  478.              write(onoff[doublespace],'     ');
  479.              optionline;
  480.            END;
  481.       '7': settopmargin;
  482.       '8': setbottommargin;
  483.       '9': BEGIN
  484.              IF automatic=1
  485.                THEN automatic := 2
  486.                ELSE automatic := 1;
  487.              gotoxy(36,13);
  488.              write(onoff[automatic],'    ');
  489.              optionline;
  490.            END;
  491.       'l': setleftmargin;
  492.       'L': setleftmargin;
  493.       'r': setrightmargin;
  494.       'R': setrightmargin;
  495.       'F': get_file;
  496.       'f': get_file;
  497.       'G': IF filename <> ''
  498.              THEN printfile;
  499.       'g': IF filename <> ''
  500.              THEN printfile;
  501.       'Q': quit;
  502.       'q': quit;
  503.     END;
  504. END;
  505.  
  506. BEGIN
  507.   init;
  508.   menu;
  509.   REPEAT
  510.     gotoxy (35,21);
  511.     REPEAT
  512.       read (kbd,option)
  513.     UNTIL option
  514.                IN ['0','1','2','3','4','5','6','g','G','q','Q','7','8','f','F',
  515.                     'r','R','l','L','9'];
  516.     action;
  517.   UNTIL hellfreezesover = true;
  518. END.
  519.