 

{  18/7/87  21:52   labels}

%begin

%include "sm:consts.inc"
%include "sm:formats.inc"
%include "sm:persons.inc"
%include "sm:utils.inc"

%constreal chperinch=12     ;!  Characters per inch for font Times10.
{!  If Vax.}
{%recordformat df(%integer l, a)}
{%record(df) d}
{%externalroutinespec do command %alias "LIB$DO_COMMAND"(%record(df)%name d)}
!
!  If APM.
%externalpredicatespec exists(%string(255) s)
!
%owninteger horizlabels=2    ;!  Maximum number of labels across the page.
%constreal indent=0.2        ;!  Left-hand margin on each label in inches.
%owninteger i,labelcount
%constreal labeldepth=1.5714  ;!  Depth of a label in inches.
%ownreal printdepth
%string(31) labels
%constreal labelwidth=3.741  ;!  Width of a label in inches.
%constreal leftm=0.342       ;!  Margin at left of page of labels.
%constreal leftmargin=0.2    ;!  Margin at left of a label.
%constreal linesperinch=6    ;!  Lines per inch for Times10.
%ownreal linewidth
%constinteger maxpts=14        ;!  Largest type size for labels.
%constinteger minpts=6         ;!  Smallest type size for labels.
%record(line80listf) recip
%string(31) source
%integer tolaser
%constreal top=0.342         ;!  Margin at top of page of labels.
%constreal topmargin=0.2       ;!  Margin at top of label.
%owninteger vertlabels=7     ;!  Maximum number of labels down the page.
%string(255) w
%constrealarray width(0:255)= %c
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
866,600,866,1000,1066,1133,1200,533,
733,733,733,1266,600,1266,600,1066,
933,933,933,933,933,933,933,933,
933,933,600,600,1133,1266,1133,933,
1200,1000,1133,1000,1133,1066,1000,1133,
1200,666,866,1133,933,1333,1133,1066,
1066,1066,1133,1066,1066,1200,1000,1266,
1066,933,933,733,1066,733,1133,866,
533,1000,1066,866,1066,866,800,933,
1200,666,666,1133,666,1733,1200,933,
1066,1000,933,933,800,1200,1000,1266,
1000,1000,866,733,466,733,1133,0,
0(*)
%string(255) x,y,z

%realfn hershey length(%string(255) s,%integer points)
%real x
%integer i
  x=0
  %for i=1,1,length(s) %cycle
    x=x+width(charno(s,i))
  %repeat
  x=x*points/100000
  %result=x
%end

%routine remove(%record(*)%name p,l)
  excise cell(p,l)
  dispose(p)
%end

%routine copy address(%record(line80listf)%name a,b)
%record(line80f)%name p,q
  b_head==nil; b_tail==nil
  p==a_head
  %while p##nil %cycle
    q==newline80
    q_line=p_line
    append cell(q,b)
    p==p_next
  %repeat
%end


%routine get addressee(%record(line80listf)%name r)
%record(line80f)%name p
%string(80) x
  %on %event 9,15 %start
    delete list(r) %unless r_head==nil
    p==newline80
    p_line=".end"
    append cell(p,r)
    %return
  %finish
  input(x,1)
  length(x)=length(x)-1 %while charno(x,length(x))=',' %c
  %or charno(x,length(x))=sp %or charno(x,length(x))='.'
  %signal %event 15,1 %if x="*"
  get address(r,0)
  %signal %event 15,1 %if r_head==nil %or r_head_line="*"
  p==newline80
  p_line=x
  prefix cell(p,r)
%end

{  Main Program}

!  Seqno uses input and output streams 1.


  select input(0); select output(0)
  linewidth=labelwidth-2*leftmargin
  printdepth=labeldepth-2*topmargin
  tolaser=yes
  message("Type ""?"" for HELP, "".end"" to abandon.","")
  %cycle
    get(source,41)
    %exit %if exists(source)
    message(source." does not exist.","")
  %repeat
  prompt(prt(48))
  print string(snl.prt(48).snl)
  tolaser=panswer(48)
  labels=""
!  If APM.
  labels="lp2:" %if tolaser=yes
!
  labels=labels."x".seqno.".lay"
  open input(1,source)
  select input(1)
  labelcount=0
  %cycle
    get addressee(recip)
    %exit %if recip_head_line=end
    labelcount=labelcount+1
    delete list(recip)
  %repeat
  i=(labelcount+13)//14
  close input
  open input(1,source)
  select input(1)
  open output(1,labels)
  select output(1)
  print string("$Z.pause INSERT ".itod(i)." SHEET")
  print string("S") %if i#1
  print string(" OF LABELS".snl)
  print string("$Z.include office:labelstyle".snl)
  print string("$Y0 $labelpage".snl)
  %cycle
    get addressee(recip)
    %exit %if recip_head_line=end
    print label(recip)
    delete list(recip)
  %repeat
  print string(snl."$E*".snl)
  close output
  select output(0)
  %if tolaser=yes %thenstart
{!  If Vax.}
{    x="@U0:[SM.OFFICE]LAS ".labels}
{    d_a=addr(x)+1; d_l=length(x)}
{    do command(d)}
!
!  If APM.
    message("Labels sent to laser printer in ".labels,"")
!
  %finishelse message("Labels are in ".labels,"")


%endofprogram
