home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
cpm
/
parasol
/
videosto.ark
/
REPORT.LIB
< prev
next >
Wrap
Text File
|
1986-07-20
|
6KB
|
230 lines
string report.line 137;
string heading.1 81;
string heading.2 81;
string report.date 9 value " ";
word report.width value 0;
word page.size value 0;
word page.num value 0;
word line.counter value 66;
byte page.letter value ' ';
byte report.device value 'P';
byte lines.to.check value 1;
byte end.report.inhibit.form.feed value "N";
print off;
{------------------------------------------------------
{ REPORT PRINTING PROCEDURE
{
{ first, set all variables above and call init.report
{ report.width and page.size will be set by init.report
{ if they have not been set by the caller.
{ for each line to print put it into report.line and
{ call print.report.line;
{ heading.1 and heading.2 are optional,
{ but one heading line is always printed showing the
{ date and page number. A second heading line is printed
{ if heading.2 is not null.
{ page.letter is printed immediately following the
{ page number for reports wider than one page
{ User must supply procedure report.heading for any special
{ headings before the first print.line.
{ A new page may be forced by calling print.heading.
{ At the end of the report, end.report should be called.
{-------------------------------------------------------
external label `rpt.entry address 5;
string `rpt.line 137;
string `rpt.save 137;
string `rpt.str.8 9;
byte `rpt.byte;
word `rpt.word;
byte pointer `rpt.bp;
byte `rpt.ch;
file `rpt.prn,
prn,
text,
record `rpt.ch;
{---------------------------------------------
procedure `rpt.ch.out:
begin
if report.device = 'S' then
mcall `rpt.entry using 2,`rpt.ch;
else
write `rpt.prn;
fi;
end;
{---------------------------------------------
procedure `clr.report.line:
begin
fill report.line with " ";
add report.width to #report.line giving `rpt.bp;
move 0 to @`rpt.bp;
end;
{---------------------------------------------
procedure init.report:
begin
if report.device = 'S' then
if report.width = 0 then
move 79 to report.width;
fi;
if page.size = 0 then
move 22 to page.size;
fi;
else
if report.width = 0 then
move 136 to report.width;
fi;
if page.size = 0 then
move 60 to page.size;
fi;
fi;
add 1 to page.size giving line.counter;
move 0 to page.num;
call `clr.report.line;
do
mcall `rpt.entry using 11 giving ,,,`rpt.byte;
if `rpt.byte = 0 then
exitdo;
fi;
mcall `rpt.entry using 1 giving ,,,`rpt.byte;
od;
end;
{---------------------------------------------
procedure `ctr.hdg:
begin
scan `rpt.line for trailing ' '
giving `rpt.word address `rpt.bp;
move 0 to @`rpt.bp;
while `rpt.word < report.width do
move `rpt.line to `rpt.line[+1] length 131 reverse;
move ' ' to `rpt.line[byte];
add 2 to `rpt.word;
od;
size `rpt.line giving `rpt.word;
while `rpt.word < report.width do
append ' ' to `rpt.line;
add 1 to `rpt.word;
od;
end;
{---------------------------------------------
procedure `rpt.page:
begin
move 'N' to `rpt.byte;
if page.num <> 0 then
move 'Y' to `rpt.byte;
fi;
switch on page.letter:
' ','A': null;
else move 'Y' to `rpt.byte;
endswitch;
if `rpt.byte = 'Y' then
if report.device = 'S' then
accept "Press return to continue", `rpt.str.8;
else
move 12 to `rpt.ch;
call `rpt.ch.out;
fi; fi;
move 0 to line.counter;
add 1 to page.num;
end;
{---------------------------------------------
procedure print.heading:
begin
move `rpt.line to `rpt.save length 136;
call `rpt.page;
move heading.1 to `rpt.line;
call `ctr.hdg;
scan report.date for no ' ' true begin
move 'DATE:' to `rpt.line length 5;
move report.date to `rpt.str.8;
move `rpt.str.8 to `rpt.line[+5] length 8;
end;
convert page.num to dec `rpt.str.8;
edit `rpt.str.8 with 'ZZ9';
if report.device <> 'S' then
move 'PAGE:' to `rpt.line[+122] length 5;
move `rpt.str.8 to `rpt.line[+127] length 3;
move page.letter to `rpt.line[+131,byte];
else
move 'PAGE:' to `rpt.line[+69] length 5;
move `rpt.str.8 to `rpt.line[+74] length 3;
move page.letter to `rpt.line[+78,byte];
fi;
call `rpt.print.line;
if heading.2 <> '' then
move heading.2 to `rpt.line;
call `ctr.hdg;
call `rpt.print.line;
fi;
call `clr.report.line;
call report.heading;
move `rpt.save to `rpt.line length 136;
end;
{---------------------------------------------
procedure check.free.lines:
begin
subtract line.counter from page.size giving `rpt.word;
if `rpt.word < lines.to.check then
move report.line to `rpt.line length 136;
call print.heading;
move `rpt.line to report.line length 136;
fi;
end;
{---------------------------------------------
procedure `rpt.print.line:
begin
mcall `rpt.entry using 11 giving ,,,`rpt.byte;
if `rpt.byte <> 0 then
mcall `rpt.entry using 1 giving ,,,`rpt.byte;
accept "Do You want to quit printing? (Y/N):",`rpt.str.8;
if `rpt.str.8[byte] = 'Y'
or `rpt.str.8[byte] = 'y' then
call end.report;
goto report.exit;
fi; fi;
if line.counter > page.size then
call print.heading;
fi;
add report.width to #`rpt.line giving `rpt.bp;
move 0 to @`rpt.bp;
scan `rpt.line for trailing " " giving address `rpt.bp;
move 0 to @`rpt.bp;
move #`rpt.line to `rpt.bp;
while @`rpt.bp <> 0 do
move @`rpt.bp to `rpt.ch;
call `rpt.ch.out;
add 1 to `rpt.bp;
od;
move 13 to `rpt.ch;
call `rpt.ch.out;
move 10 to `rpt.ch;
call `rpt.ch.out;
add 1 to line.counter;
fill `rpt.line with " ";
add report.width to #`rpt.line giving `rpt.bp;
move 0 to @`rpt.bp;
end;
{---------------------------------------------
procedure print.report.line:
begin
move report.line to `rpt.line length 136;
call `rpt.print.line;
call `clr.report.line;
end;
{---------------------------------------------
procedure end.report:
begin
if report.device = 'S' then
call `rpt.page;
else
if end.report.inhibit.form.feed <> "Y" then
move ^h0c to `rpt.ch;
call `rpt.ch.out;
move "N" to end.report.inhibit.form.feed;
fi;
move ^h1a to `rpt.ch;
call `rpt.ch.out;
fi;
end;
print on;