home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PARASOL / VIDEOSTO.ARK / REPORT.LIB < prev    next >
Text File  |  1986-07-20  |  6KB  |  230 lines
  1. string            report.line            137;
  2. string            heading.1    81;
  3. string            heading.2    81;
  4. string            report.date            9    value    "        ";
  5. word            report.width                value    0;
  6. word            page.size                value    0;
  7. word            page.num                value    0;
  8. word            line.counter            value    66;
  9. byte            page.letter                value    ' ';
  10. byte            report.device            value    'P';
  11. byte            lines.to.check            value    1;
  12. byte    end.report.inhibit.form.feed    value    "N";
  13. print off;
  14. {------------------------------------------------------
  15. {    REPORT PRINTING PROCEDURE
  16. {
  17. {    first, set all variables above and call init.report
  18. {        report.width and page.size will be set by init.report
  19. {        if they have not been set by the caller.
  20. {    for each line to print put it into report.line and
  21. {        call print.report.line;
  22. {    heading.1 and heading.2 are optional,
  23. {    but one heading line is always printed showing the
  24. {    date and page number.  A second heading line is printed
  25. {    if heading.2 is not null.
  26. {        page.letter is printed immediately following the
  27. {        page number for reports wider than one page
  28. {    User must supply procedure report.heading for any special
  29. {        headings before the first print.line.
  30. {    A new page may be forced by calling print.heading.
  31. {    At the end of the report, end.report should be called.
  32. {-------------------------------------------------------
  33. external label    `rpt.entry            address    5;
  34. string            `rpt.line            137;
  35. string            `rpt.save            137;
  36. string            `rpt.str.8            9;
  37. byte            `rpt.byte;
  38. word            `rpt.word;
  39. byte pointer    `rpt.bp;
  40.  
  41.  
  42. byte    `rpt.ch;
  43. file    `rpt.prn,
  44.         prn,
  45.         text,
  46.         record    `rpt.ch;
  47. {---------------------------------------------
  48. procedure    `rpt.ch.out:
  49. begin
  50.     if report.device = 'S' then
  51.         mcall `rpt.entry using 2,`rpt.ch;
  52.     else
  53.         write `rpt.prn;
  54.         fi;
  55. end;
  56. {---------------------------------------------
  57. procedure    `clr.report.line:
  58. begin
  59.     fill report.line with " ";
  60.     add report.width to #report.line giving `rpt.bp;
  61.     move 0 to @`rpt.bp;
  62. end;
  63. {---------------------------------------------
  64. procedure    init.report:
  65. begin
  66.     if report.device = 'S' then
  67.         if report.width = 0 then
  68.             move 79 to report.width;
  69.             fi;
  70.         if page.size = 0 then
  71.             move 22 to page.size;
  72.             fi;
  73.     else
  74.         if report.width = 0 then
  75.             move 136 to report.width;
  76.             fi;
  77.         if page.size = 0 then
  78.             move 60 to page.size;
  79.             fi;
  80.         fi;
  81.     add 1 to page.size giving line.counter;
  82.     move 0 to page.num;
  83.     call `clr.report.line;
  84.     do
  85.         mcall `rpt.entry using 11 giving ,,,`rpt.byte;
  86.         if `rpt.byte = 0 then
  87.             exitdo;
  88.             fi;
  89.         mcall `rpt.entry using 1 giving ,,,`rpt.byte;
  90.         od;
  91. end;
  92. {---------------------------------------------
  93. procedure `ctr.hdg:
  94. begin
  95.     scan `rpt.line for trailing ' '
  96.             giving `rpt.word address `rpt.bp;
  97.     move 0 to @`rpt.bp;
  98.     while `rpt.word < report.width do
  99.         move `rpt.line to `rpt.line[+1] length 131 reverse;
  100.         move ' ' to `rpt.line[byte];
  101.         add 2 to `rpt.word;
  102.         od;
  103.     size `rpt.line giving `rpt.word;
  104.     while `rpt.word < report.width do
  105.         append ' ' to `rpt.line;
  106.         add 1 to `rpt.word;
  107.         od;
  108.     end;
  109. {---------------------------------------------
  110. procedure    `rpt.page:
  111. begin
  112.     move 'N' to `rpt.byte;
  113.     if page.num <> 0 then
  114.         move 'Y' to `rpt.byte;
  115.         fi;
  116.     switch on page.letter:
  117.     ' ','A':    null;
  118.     else        move 'Y' to `rpt.byte;
  119.     endswitch;
  120.     if `rpt.byte = 'Y' then
  121.         if report.device = 'S' then
  122.             accept "Press return to continue", `rpt.str.8;
  123.         else
  124.             move 12 to `rpt.ch;
  125.             call  `rpt.ch.out;
  126.         fi;    fi;
  127.     move 0 to line.counter;
  128.     add 1 to page.num;
  129. end;
  130. {---------------------------------------------
  131. procedure    print.heading:
  132. begin
  133.     move `rpt.line to `rpt.save length 136;
  134.     call `rpt.page;
  135.     move heading.1 to `rpt.line;
  136.     call `ctr.hdg;
  137.     scan report.date for no ' ' true begin
  138.         move 'DATE:' to `rpt.line length 5;
  139.         move report.date to `rpt.str.8;
  140.         move `rpt.str.8 to `rpt.line[+5] length 8;
  141.         end;
  142.     convert page.num to dec `rpt.str.8;
  143.     edit `rpt.str.8 with 'ZZ9';
  144.     if report.device <> 'S' then
  145.         move 'PAGE:' to `rpt.line[+122] length 5;
  146.         move `rpt.str.8 to `rpt.line[+127] length 3;
  147.         move page.letter to `rpt.line[+131,byte];
  148.     else
  149.         move 'PAGE:' to `rpt.line[+69] length 5;
  150.         move `rpt.str.8 to `rpt.line[+74] length 3;
  151.         move page.letter to `rpt.line[+78,byte];
  152.         fi;
  153.     call `rpt.print.line;
  154.     if heading.2 <> '' then
  155.         move heading.2 to `rpt.line;
  156.         call `ctr.hdg;
  157.         call `rpt.print.line;
  158.         fi;
  159.     call `clr.report.line;
  160.     call report.heading;
  161.     move `rpt.save to `rpt.line length 136;
  162. end;
  163. {---------------------------------------------
  164. procedure    check.free.lines:
  165. begin
  166.     subtract line.counter from page.size giving `rpt.word;
  167.     if `rpt.word < lines.to.check then
  168.         move report.line to `rpt.line length 136;
  169.         call print.heading;
  170.         move `rpt.line to report.line length 136;
  171.         fi;
  172. end;
  173. {---------------------------------------------
  174. procedure `rpt.print.line:
  175. begin
  176.     mcall `rpt.entry using 11 giving ,,,`rpt.byte;
  177.     if `rpt.byte <> 0 then
  178.         mcall `rpt.entry using 1 giving ,,,`rpt.byte;
  179.         accept "Do You want to quit printing? (Y/N):",`rpt.str.8;
  180.         if `rpt.str.8[byte] = 'Y'
  181.         or `rpt.str.8[byte] = 'y' then
  182.             call end.report;
  183.             goto report.exit;
  184.         fi;    fi;
  185.     if line.counter > page.size then
  186.         call print.heading;
  187.         fi;
  188.     add report.width to #`rpt.line giving `rpt.bp;
  189.     move 0 to @`rpt.bp;
  190.     scan `rpt.line for trailing " " giving address `rpt.bp;
  191.     move 0 to @`rpt.bp;
  192.     move #`rpt.line to `rpt.bp;
  193.     while @`rpt.bp <> 0 do
  194.         move @`rpt.bp to `rpt.ch;
  195.         call  `rpt.ch.out;
  196.         add 1 to `rpt.bp;
  197.         od;
  198.     move 13 to `rpt.ch;
  199.     call  `rpt.ch.out;
  200.     move 10 to `rpt.ch;
  201.     call  `rpt.ch.out;
  202.     add 1 to line.counter;
  203.     fill `rpt.line with " ";
  204.     add report.width to #`rpt.line giving `rpt.bp;
  205.     move 0 to @`rpt.bp;
  206.     end;
  207. {---------------------------------------------
  208. procedure    print.report.line:
  209. begin
  210.     move report.line to `rpt.line length 136;
  211.     call `rpt.print.line;
  212.     call `clr.report.line;
  213. end;
  214. {---------------------------------------------
  215. procedure    end.report:
  216. begin
  217.     if report.device = 'S' then
  218.         call `rpt.page;
  219.     else
  220.         if end.report.inhibit.form.feed <> "Y" then
  221.             move ^h0c to `rpt.ch;
  222.             call `rpt.ch.out;
  223.             move "N" to end.report.inhibit.form.feed;
  224.             fi;
  225.         move ^h1a to `rpt.ch;
  226.         call `rpt.ch.out;
  227.         fi;
  228. end;
  229. print on;
  230.