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 / MAIL-LBL.LIB < prev    next >
Text File  |  1986-10-03  |  13KB  |  508 lines
  1. {-------------------------------------------------------------------
  2.  
  3. record    inqlabel;
  4.     byte    inqlabel.num.wide        value    "4";
  5.     field    inqlabel.data.width    2    value    "40";
  6.     field    inqlabel.chars.between    2    value    "5";
  7.     field    inqlabel.label.lines    2    value    "6";
  8.     byte    inqlabel.life.annual        value    " ";
  9.     field    inqlabel.month.joined    2    value    "  ";
  10.     field    inqlabel.year.joined    2    value    "  ";
  11.     endrec;
  12.  
  13.                                         redefine screen.data;
  14. record    sc.inqlabel;
  15.     string    ##inqlabel;
  16.     endrec;
  17.                                         endredef;
  18.  
  19.  
  20. byte            data.this.line            value    "N";
  21. word pointer    lbl.wp;
  22.  
  23. byte    lbl.cnt;
  24. byte    num.labels;
  25. byte    label.data.width;
  26. byte    label.chars.between;
  27. byte    label.lines;
  28. byte    lbl.line.ctr;
  29.  
  30. record    label.data;
  31.     record    label.1;
  32.         field    label.name        50;
  33.         field    label.addr        50;
  34.         field    label.city        50;
  35.         field    label.zip        10;
  36.         endrec;
  37.     string    (##label.1 * 3);    {--max 4-wide labels--}
  38.     endrec;
  39.  
  40. record    label.m.keys;
  41.     word    label.m.key;
  42.     string                30;
  43.     endrec;
  44.  
  45. byte    disk.out.open    value    "N";
  46. byte    disk.out.byte;
  47. string    disk.out.buff    128;
  48. file    disk.out,
  49.         disk,    text,
  50.         record    disk.out.byte,
  51.         buffer    disk.out.buff,
  52.         value    "LABEL.OUT";
  53.  
  54. {-------------------------------------------------------------------
  55. byte pointer pri.bp;
  56. procedure    put.report.item:
  57. begin
  58.     if inqlabel.num.wide = "D" then
  59.         if disk.out.open <> "Y" then
  60.             open disk.out output remove error standard;
  61.             move "Y" to disk.out.open;
  62.             fi;
  63.         if data.this.line = "Y" then
  64.             move "," to disk.out.byte;    write disk.out;
  65.             fi;
  66.         while wk.str[byte] = " " do
  67.             move wk.str[+1] to wk.str;
  68.             od;
  69.         move #wk.str to wk.bp;
  70.         move '"' to disk.out.byte;    write disk.out;
  71.         while @wk.bp <> 0 do
  72.             move @wk.bp to disk.out.byte;    write disk.out;
  73.             add 1 to wk.bp;
  74.             od;
  75.         move '"' to disk.out.byte;    write disk.out;
  76.     else
  77.         subtract #report.line from pri.bp giving wk.word;
  78.         move #wk.str to wk.bp;
  79.         while wk.word < report.width
  80.         and @wk.bp <> 0 do
  81.             move @wk.bp to @pri.bp;
  82.             add 1 to pri.bp;
  83.             add 1 to wk.bp;
  84.             add 1 to wk.word;
  85.             od;
  86.         fi;
  87.     move 'Y' to data.this.line;
  88. end;
  89. {-------------------------------------------------------------------
  90. procedure    init.report.line:
  91. begin
  92.     move 'N' to data.this.line;
  93.     move #report.line to pri.bp;
  94.     fill report.line with ' ';
  95. end;
  96. {-------------------------------------------------------------------
  97. procedure    label.print.mask:
  98. begin
  99.     if inqlabel.num.wide <> "D" then
  100.         move 0 to lbl.line.ctr;
  101.         call init.report.line;
  102.         move 0 to lbl.cnt;
  103.         do
  104.             add 1 to lbl.cnt;
  105.             fill wk.str with ".";
  106.             move "Name" to wk.str length 4;
  107.             add #wk.str to label.data.width giving wk.bp;
  108.             move 0 to @wk.bp;
  109.             call label.put.item;
  110.             od until lbl.cnt >= num.labels;
  111.         call print.report.line;
  112.         add 1 to lbl.line.ctr;
  113.         call init.report.line;
  114.         move 0 to lbl.cnt;
  115.         do
  116.             add 1 to lbl.cnt;
  117.             fill wk.str with ".";
  118.             move "Address" to wk.str length 7;
  119.             add #wk.str to label.data.width giving wk.bp;
  120.             move 0 to @wk.bp;
  121.             call label.put.item;
  122.             od until lbl.cnt >= num.labels;
  123.         call print.report.line;
  124.         add 1 to lbl.line.ctr;
  125.         call init.report.line;
  126.         move 0 to lbl.cnt;
  127.         do
  128.             add 1 to lbl.cnt;
  129.             fill wk.str with ".";
  130.             move "City, State" to wk.str length 11;
  131.             add #wk.str to label.data.width giving wk.bp;
  132.             move 0 to @wk.bp;
  133.             call label.put.item;
  134.             od until lbl.cnt >= num.labels;
  135.         call print.report.line;
  136.         add 1 to lbl.line.ctr;
  137.         call init.report.line;
  138.         move 0 to lbl.cnt;
  139.         do
  140.             add 1 to lbl.cnt;
  141.             fill wk.str with ".";
  142.             add #wk.str to label.data.width giving wk.bp;
  143.             move 0 to @wk.bp;
  144.             subtract 5 from wk.bp;
  145.             move "*Zip*" to @wk.bp[sp] length 5;
  146.             call label.put.item;
  147.             od until lbl.cnt >= num.labels;
  148.         call print.report.line;
  149.         add 1 to lbl.line.ctr;
  150.         call init.report.line;
  151.         move label.lines to lbl.cnt;
  152.         subtract lbl.line.ctr from lbl.cnt;
  153.         while lbl.cnt <> 0 do
  154.             call print.report.line;
  155.             subtract 1 from lbl.cnt;
  156.             od;
  157.         fi;
  158. end;
  159. {-------------------------------------------------------------------
  160. procedure    get.label.member:
  161. begin
  162.     if @lbl.wp <> m.key then
  163.         move @lbl.wp to m.key;
  164.         read member error standard;
  165.         call justify.member.fields;
  166.         fi;
  167. end;
  168. {-------------------------------------------------------------------
  169. procedure    space.to.next.label:
  170. begin
  171.     if inqlabel.num.wide <> "D"
  172.     and lbl.cnt < num.labels then
  173.         fill wk.str with " ";
  174.         add #wk.str to label.chars.between giving wk.bp;
  175.         move 0 to @wk.bp;
  176.         call put.report.item;
  177.         fi;
  178. end;
  179. {-------------------------------------------------------------------
  180. procedure    label.put.item:
  181. begin
  182.     if inqlabel.num.wide <> "D" then
  183.         do
  184.             size wk.str giving wk.byte;
  185.             if wk.byte >= label.data.width then
  186.                 exitdo;
  187.                 fi;
  188.             append "     " to wk.str;
  189.             od;
  190.         add #wk.str to label.data.width giving wk.bp;
  191.         move 0 to @wk.bp;
  192.     else
  193.         call trunc.wk.str;
  194.         fi;
  195.     call put.report.item;
  196.     call space.to.next.label;
  197. end;
  198. {-------------------------------------------------------------------
  199. procedure    build.city.state.zip:
  200. begin
  201.     move m.city to wk.str;
  202.     call trunc.wk.str;
  203.     scan wk.str for "~ff~" giving address wk.bp; {-ptr to null byte-}
  204.     subtract 1 from wk.bp;
  205.     if @wk.bp = "," then
  206.         append " " to wk.str;
  207.     else
  208.         append ", " to wk.str;
  209.         fi;
  210.     move m.state to wk.str.2;
  211.     append wk.str.2 to wk.str;
  212.     call trunc.wk.str;
  213.     if label.lines < 5 then
  214.         append "   " to wk.str;
  215.         move m.zip to wk.str.2;
  216.         append wk.str.2 to wk.str;
  217.         fi;
  218.     call trunc.wk.str;
  219. end;
  220. {-------------------------------------------------------------------
  221. procedure    skip.label.item:
  222. begin
  223.     if inqlabel.num.wide <> "D" then
  224.         fill wk.str with " ";
  225.         add #wk.str to label.data.width giving wk.bp;
  226.         move 0 to @wk.bp;
  227.     else
  228.         move "" to wk.str;
  229.         fi;
  230.     call put.report.item;
  231.     call space.to.next.label;
  232. end;
  233. {-------------------------------------------------------------------
  234. procedure    put.zip.alone:
  235. begin
  236.     if label.lines > 4 then
  237.         move m.zip to wk.str;
  238.         call trunc.wk.str;
  239.         add #wk.str to label.data.width giving wk.bp;
  240.         move 0 to @wk.bp;
  241.         justify wk.str right length label.data.width;
  242.         call put.report.item;
  243.         call space.to.next.label;
  244.     else
  245.         call skip.label.item;
  246.         fi;
  247. end;
  248. {-------------------------------------------------------------------
  249. procedure    print.all.labels:
  250. begin
  251.     move 0 to lbl.line.ctr;
  252.     {-----------------
  253.     {    Print name
  254.     {-----------------
  255.     call init.report.line;
  256.     move #label.m.keys to lbl.wp;
  257.     move 0 to lbl.cnt;
  258.     do
  259.         add 1 to lbl.cnt;
  260.         if @lbl.wp <> 0 then
  261.             call get.label.member;
  262.             move m.f.name to wk.str;
  263.             call trunc.wk.str;
  264.             move " " to wk.str.2[byte];
  265.             move m.l.name to wk.str.2[+1];
  266.             append wk.str.2 to wk.str;
  267.             call trunc.wk.str;
  268.             call label.put.item;
  269.             fi;
  270.         add 2 to lbl.wp;
  271.         od until lbl.cnt >= num.labels;
  272.     if data.this.line = 'Y'
  273.     and inqlabel.num.wide <> "D" then
  274.         call print.report.line;
  275.         add 1 to lbl.line.ctr;
  276.         call init.report.line;
  277.         fi;
  278.     {-----------------
  279.     {    Print address
  280.     {-----------------
  281.     move #label.m.keys to lbl.wp;
  282.     move 0 to lbl.cnt;
  283.     do
  284.         add 1 to lbl.cnt;
  285.         if @lbl.wp <> 0 then
  286.             call get.label.member;
  287.             move m.addr to wk.str;
  288.             call label.put.item;
  289.             fi;
  290.         add 2 to lbl.wp;
  291.         od until lbl.cnt >= num.labels;
  292.     if data.this.line = 'Y'
  293.     and inqlabel.num.wide <> "D" then
  294.         call print.report.line;
  295.         add 1 to lbl.line.ctr;
  296.         call init.report.line;
  297.         fi;
  298.     {-----------------
  299.     {    print line 3 (City, State)
  300.     {-----------------
  301.     move #label.m.keys to lbl.wp;
  302.     move 0 to lbl.cnt;
  303.     do
  304.         add 1 to lbl.cnt;
  305.         if @lbl.wp <> 0 then
  306.             call get.label.member;
  307.             call build.city.state.zip;
  308.             call label.put.item;
  309.             fi;
  310.         add 2 to lbl.wp;
  311.         od until lbl.cnt >= num.labels;
  312.     if data.this.line = 'Y'
  313.     and inqlabel.num.wide <> "D" then
  314.         call print.report.line;
  315.         add 1 to lbl.line.ctr;
  316.         call init.report.line;
  317.         fi;
  318.     {-----------------
  319.     {    print line 4 (Zip)
  320.     {-----------------
  321.     move #label.m.keys to lbl.wp;
  322.     move 0 to lbl.cnt;
  323.     do
  324.         add 1 to lbl.cnt;
  325.         if @lbl.wp <> 0 then
  326.             call get.label.member;
  327.             if label.lines > 4 then
  328.                 call put.zip.alone;
  329.             else
  330.                 call skip.label.item;
  331.                 fi;
  332.             fi;
  333.         add 2 to lbl.wp;
  334.         od until lbl.cnt >= num.labels;
  335.     if data.this.line = 'Y'
  336.     and inqlabel.num.wide <> "D" then
  337.         call print.report.line;
  338.         add 1 to lbl.line.ctr;
  339.         call init.report.line;
  340.         fi;
  341. {    {-----------------
  342. {    {    print line 5 -- (null, or zip)
  343. {    {-----------------
  344. {    move #label.m.keys to lbl.wp;
  345. {    move 0 to lbl.cnt;
  346. {    do
  347. {        add 1 to lbl.cnt;
  348. {        if @lbl.wp <> 0 then
  349. {            call get.label.member;
  350. {            if label.lines > 4 then
  351. {                call put.zip.alone;
  352. {            else
  353. {                call skip.label.item;
  354. {                fi;
  355. {            fi;
  356. {        add 2 to lbl.wp;
  357. {        od until lbl.cnt >= num.labels;
  358. {    if data.this.line = 'Y'
  359. {    and inqlabel.num.wide <> "D" then
  360. {        call print.report.line;
  361. {        add 1 to lbl.line.ctr;
  362. {        call init.report.line;
  363. {        fi;
  364.     if inqlabel.num.wide= "D" then
  365.         move ^h0d to disk.out.byte;    write disk.out;
  366.         move ^h0a to disk.out.byte;    write disk.out;
  367.         move "N" to data.this.line;
  368.     else
  369.         if lbl.line.ctr <> 0 then
  370.             call init.report.line;
  371.             move label.lines to lbl.cnt;
  372.             subtract lbl.line.ctr from lbl.cnt;
  373.             while lbl.cnt <> 0 do
  374.                 call print.report.line;
  375.                 subtract 1 from lbl.cnt;
  376.                 od;
  377.         fi;    fi;
  378.     fill label.m.keys with 0;
  379. end;
  380. {-------------------------------------------------------------------
  381. procedure    process.this.member:
  382. begin
  383. word    m.key.save;
  384.     move #label.m.key to lbl.wp;
  385.     move 0 to lbl.cnt;
  386.     while @lbl.wp <> 0 do
  387.         if @lbl.wp = m.key then
  388.             exit;
  389.             fi;
  390.         add 2 to lbl.wp;
  391.         add 1 to lbl.cnt;
  392.         od until lbl.cnt >= num.labels;
  393.     if lbl.cnt >= num.labels then
  394.         move m.key to m.key.save;
  395.         call print.all.labels;
  396.         move m.key.save to m.key;
  397.         fill label.m.keys with 0;
  398.         move #label.m.key to lbl.wp;
  399.         fi;
  400.     move m.key to @lbl.wp;
  401. end;
  402. {-------------------------------------------------------------------
  403.  
  404. procedure    get.label.specs:
  405. begin
  406.     move inqlabel to sc.inqlabel;
  407. inqlabel.get.data:
  408.     move "inqlabel" to screen.name;
  409.     call get.screen.data;
  410.     move sc.inqlabel to inqlabel;
  411.     if inqlabel.num.wide = "D" then
  412.         move 1 to num.labels;
  413.     else
  414.         subtract "0" from inqlabel.num.wide giving num.labels;
  415.         switch on num.labels:
  416.             0:    goto report.exit;
  417.             1 - 4:    null;
  418.             else begin
  419.                 move "Number of labels must be between 1 and 4"
  420.                                                 to status.line;
  421.                 call status.line.display;
  422.                 goto inqlabel.get.data;
  423.                 end;
  424.             endswitch;
  425.         fi;
  426.     move inqlabel.data.width to wk.str;
  427.     convert wk.str to label.data.width;
  428.     switch on label.data.width:
  429.         10 - 50:    null;
  430.         else begin
  431.             move "Data width must be between 10 and 50"
  432.                                             to status.line;
  433.             call status.line.display;
  434.             move 1 to get.data.skip.count;
  435.             goto inqlabel.get.data;
  436.             end;
  437.         endswitch;
  438.     move inqlabel.chars.between to wk.str;
  439.     convert wk.str to label.chars.between;
  440.     move inqlabel.label.lines to wk.str;
  441.     convert wk.str to label.lines;
  442.     switch on label.lines:
  443.         4 - 10:    null;
  444.         else begin
  445.             move "Lines per label must be from 4 to 10"
  446.                                             to status.line;
  447.             call status.line.display;
  448.             move 3 to get.data.skip.count;
  449.             goto inqlabel.get.data;
  450.             end;
  451.         endswitch;
  452.     switch on inqlabel.life.annual:
  453.         " ","L","A","E":    null;
  454.         else begin
  455.             move "Blank, 'L', 'E', or 'A' only" to status.line;
  456.             call status.line.display;
  457.             move 4 to get.data.skip.count;
  458.             goto inqlabel.get.data;
  459.             end;
  460.         endswitch;
  461.     if inqlabel.month.joined[word] <> "  " then
  462.         if inqlabel.month.joined[+1,byte] = " " then
  463.             move inqlabel.month.joined[byte]
  464.                     to inqlabel.month.joined[+1,byte];
  465.             move "0" to inqlabel.month.joined[byte];
  466.             fi;
  467.         move inqlabel.month.joined to wk.str;
  468.         convert wk.str to wk.byte;
  469.         switch on wk.byte:
  470.             1 - 12:    null;
  471.             else begin
  472.                 move "Blank, or 1-12 only" to status.line;
  473.                 call status.line.display;
  474.                 move 5 to get.data.skip.count;
  475.                 goto inqlabel.get.data;
  476.                 end;
  477.             endswitch;
  478.         fi;
  479.     if inqlabel.year.joined <> " " then
  480.         if inqlabel.year.joined[+1,byte] = " " then
  481.             move inqlabel.year.joined[byte]
  482.                     to inqlabel.year.joined[+1,byte];
  483.             move "0" to inqlabel.year.joined[byte];
  484.         fi;    fi;
  485.     move s.label.printer to printer.to.select;
  486.     call select.printer;
  487.     move 65000 to page.size;    {--disable headings--}
  488.     move "Y" to end.report.inhibit.form.feed;
  489.     call init.report;
  490.     move 0 to line.counter;    {--disable initial heading--}
  491.     if inqlabel.num.wide <> "D" then
  492.         do
  493.             display "Enter 'Y' for a print-mask";
  494.             display "Enter 'R' to reset label-specifications";
  495.             accept  "Enter 'N' to proceed with label printing: ",wk.str;
  496.             switch on wk.str[byte]:
  497.                 "N","n": exitdo;
  498.                 "R","r": goto get.label.specs;
  499.                 "Y","y": begin
  500.                     call label.print.mask;
  501.                     call label.print.mask;
  502.                     display "";    display "";
  503.                     end;
  504.                 endswitch;
  505.             od;
  506.         fi;
  507. end;
  508.