Category : Pascal Source Code
Archive   : TPULT.ZIP
Filename : PRINT2.PAS

 
Output of file : PRINT2.PAS contained in archive : TPULT.ZIP
PROGRAM printer;
{
JULY 9, 1984

Program to print an ASCII file in a nice way on the printer.

FEATURES:

1) A header with filename, date, time, and page #.
2) Line numbers may be included
3) # lines/page may be altered
4) Printer parameters for an Epson printer may be modified
5) Filename may be given on the program line or through menu
6) Wildcards in filename supported
7) Multiple files, separated by spaces, supported
8) Natural page breaks honored
9) Some TURBO TLIST commands honored (.PA & .CA)



Author: Todd Little
1318 Bullock
Houston, TX 77055
713-984-2055 h
578-3210 w

}

TYPE
stringtype = STRING[255];

VAR
option,I,n : INTEGER;
year : INTEGER;
month,date,day,hour,min : BYTE;
want_header,want_line_no,
want_date,want_time,want_day : BOOLEAN;
no_lines : INTEGER;
was_psp : BOOLEAN;
psp : STRING[255];
es,bx : INTEGER;
dta : ARRAY [0..127] OF BYTE;
al : BYTE;
file_search,filename : stringtype;

TYPE
mnames = ARRAY[1..12] OF STRING[3];

CONST
nmonth: mnames = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' );

{$i checkpsp.inc}
{$i getdate.inc}
{$i dta.inc}

PROCEDURE setprint;
TYPE
line_size_type = ARRAY[1..4] OF STRING[10];
epson_ls_type = ARRAY[1..4] OF STRING[1];
char_type = ARRAY[1..7] OF STRING[10];
epson_char_type = ARRAY[1..7] OF STRING[2];
intern_type = ARRAY[1..8] OF STRING[10];
VAR
I,n: INTEGER;
rsp: STRING[1];

CONST
line_size: line_size_type =('1/6"','1/8"','n/72"','n/216"');
epson_ls: epson_ls_type =('2' , '0' , 'A' , '3' );

chars: char_type =('Pica','Elite','Condensed','Enlarged',
'Enhanced','Double Hit','Silent');
epson_char: epson_char_type=( 'P' , 'M' , #15 , 'W1' ,
'E' , 'G' , 'S');

intern: intern_type=('French','German','British','Danish','Swedish',
'Italian','Spanish','Japanese');

epson_intern = 'R';
blk = ' ';
esc = #27;

BEGIN

CLRSCR;
WRITE(LST,esc,'@'); {initialize printer}
i:=0;

rsp := 'n';
WRITELN;
WRITELN('Enter a line spacing by typing Y or y ');
WRITELN('for the appropriate choice');
WRITELN;
WRITELN;
WHILE UPCASE(rsp) <> 'Y' DO
BEGIN
i:=i MOD 4 +1;
WRITELN;WRITELN;
WRITE(line_size[i],' ? ');
READLN(rsp);
IF LENGTH(rsp) = 0 THEN
rsp := 'n';
END;

IF i > 2 THEN
BEGIN
WRITE('Enter "n" ?');
READLN (n);
WRITE(LST,esc,epson_ls[i],CHAR(n));
END

ELSE
WRITE(LST,esc,epson_ls[i]);

WRITELN;
WRITELN;
WRITELN('For all of the following that are appropriate, ');
WRITELN('enter a Y or y ');
WRITELN;

FOR i:=1 TO 6 DO
BEGIN
WRITE(chars[i],' ? ');
READLN(rsp);
IF LENGTH(rsp) = 1 THEN
IF UPCASE(rsp) = 'Y' THEN
WRITE(LST,esc,epson_char[i]);
END;


WRITE( 'Select International Character Set ?');
READLN(rsp);
IF LENGTH (rsp) = 1 THEN
IF UPCASE(rsp) = 'Y' THEN
BEGIN
FOR i:=1 TO 8 DO
BEGIN
WRITELN(i,': ',intern[i]);
END;
WRITE('Enter number of international character set ');
READLN(n);
WRITE(LST,esc,epson_intern,CHAR(n));
END;
END;


PROCEDURE list;
VAR
line: STRING[255];
str_num : STRING[4];
filvar: TEXT;
I,n,need_line,res: INTEGER;
BEGIN

ASSIGN(filvar,filename);
RESET(filvar);
i:=0;
n:=0;
WHILE NOT EOF(filvar) DO
BEGIN
READLN(filvar,line);

IF (POS('{.CP',line) = 1) THEN
BEGIN
str_num := COPY( line, 5, POS( '}',line )-5 ) ;
VAL( str_num, need_line, res);
DELETE( line, 1, 80 );
IF need_line + i >= no_lines THEN line := COPY(#12,1,1);
END;

IF (POS('{.PA}',line) = 1) THEN
BEGIN
DELETE( line, 1, 80 );
line := COPY(#12, 1, 1);
END;


IF (POS(#12,line) <> 0) THEN
BEGIN
i := 0;
DELETE (line,POS(#12,line),1);
END;

IF i MOD no_lines = 0 THEN
BEGIN
n:=n+1;
IF n <> 1 THEN WRITE(LST,CHAR(12));
IF (want_header) THEN
BEGIN
WRITE(LST,' ':3,CHAR(14),filename:14,CHAR(20),' ':5);

IF (want_date) THEN
{ write(LST,month:2,'/',date:2,'/',year:2,' ':5); }
WRITE(LST,nmonth[month]:3,' ',date:2,', ',year:4,' ':4);

IF (want_time) THEN
WRITE(LST,hour:2,':',(min DIV 10):1,(min MOD 10):1);

WRITELN(LST,CHAR(14),' Page ':8,n:2);
WRITELN(LST);
WRITELN(LST);
END;
END;

i:=i+1;

IF (want_line_no) THEN
WRITE (LST,i:4,' ');
WRITELN(LST,line);
END;
WRITELN(LST,CHAR(12));
CLOSE(filvar);
END;

PROCEDURE parsename;
BEGIN

WHILE LENGTH(psp) <> 0 DO
BEGIN
file_search := getword(psp);
file_search := CONCAT(file_search,CHR(0));
getfile(file_search);
save_dta{(es,bx,dta)};
WHILE LENGTH(filename) <> 0 DO
BEGIN
list;
getdta{(es,bx)};
restore_dta{(es,bx,dta)};
getnext;
save_dta{(es,bx,dta)};
END;
END;
END;

PROCEDURE fileparms;
VAR
rsp : STRING[1];

BEGIN

want_line_no := FALSE;
want_header := TRUE;
want_date := TRUE;
want_time := TRUE;
no_lines := 55;

CLRSCR;
WRITE('Number of lines per page : ');
READLN(no_lines);

WRITE('Line numbers (Y/N) : ');
READLN(rsp);
IF LENGTH(rsp) <> 0 THEN
want_line_no := UPCASE(rsp) = 'Y';

WRITE('Page header (Y/N) : ');
READLN(rsp);
IF LENGTH(rsp) <> 0 THEN
want_header := UPCASE(rsp) = 'Y';

IF (want_header) THEN
BEGIN

WRITE('Date header (Y/N) : ');
READLN(rsp);
IF LENGTH(rsp) <> 0 THEN
want_date := UPCASE(rsp) = 'Y';

WRITE('Time header (Y/N) : ');
READLN(rsp);
IF LENGTH(rsp) <> 0 THEN
want_time := UPCASE(rsp) = 'Y';
END;
END;


PROCEDURE menu;
BEGIN
CLRSCR;
GOTOXY(10,3);
WRITE('1) Print file');
GOTOXY(10,5);
WRITE('2) Change printer attributes');
GOTOXY(10,7);
WRITE('3) Change print file attributes');
GOTOXY(10,9);
WRITE('4) Stop');
GOTOXY(20,21);
WRITE('Enter option ');
READ(option);
END;


BEGIN

want_line_no := FALSE;
want_header := TRUE;
want_date := TRUE;
want_time := TRUE;
no_lines := 55;
option:=1;

getdate(year,month,date,hour,min);

checkpsp(was_psp,psp);
getdta{(es,bx)};

IF was_psp THEN
BEGIN
parsename;
option := 4;
END;

WHILE option <> 4 DO
BEGIN
menu;
IF(option = 2) THEN setprint;
IF(option = 3) THEN fileparms;
IF(option = 1) THEN
BEGIN
CLRSCR;
WRITE('Enter name of file: ');
READLN(psp);
parsename;
END;
END;
end.




  3 Responses to “Category : Pascal Source Code
Archive   : TPULT.ZIP
Filename : PRINT2.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/