home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #31 / NN_1992_31.iso / spool / alt / sources / 2882 < prev    next >
Encoding:
Internet Message Format  |  1992-12-24  |  9.8 KB
  1. Path: sparky!uunet!van-bc!cs.ubc.ca!unixg.ubc.ca!reg.triumf.ca!advax
  2. From: advax@reg.triumf.ca (A.Daviel)
  3. Newsgroups: alt.sources
  4. Subject: Canadian Postcode matrix generator for Laserjet
  5. Date: 24 Dec 1992 14:39 PST
  6. Organization: TRIUMF: Tri-University Meson Facility
  7. Lines: 349
  8. Distribution: canada
  9. Message-ID: <24DEC199214390279@reg.triumf.ca>
  10. NNTP-Posting-Host: reg.triumf.ca
  11. News-Software: VAX/VMS VNEWS 1.41    
  12.  
  13. This program prints commercial size envelopes on an HP Laserjet II, using
  14. the manual feed feature. It gets the mailing address and senders address from
  15. a textfile containing a letter to be sent. It assumes that the first lines of 
  16. the letter are the mailing address, and the last lines are the senders 
  17. address. It tries to find a Canadian Postcode and validate it. If a valid 
  18. postcode is found, it generates the precode matrix as found on 1991 
  19. greetmore envelopes and billing return envelopes. This will be recognised by 
  20. the sorting machines and result in a quicker passage through the sorting 
  21. process.
  22.  
  23. Canada Post currently uses fairly smart OCR machines. They can cope with a 
  24. variety of fonts, preferably fixed-pitch, black, upper-case and with a uniform 
  25. font used throughout the address. If posted within Canada, the 
  26. postcode should be on the last line. If posted outside Canada, the postcode 
  27. should be on the penultimate line separated from the province code by 2 
  28. spaces, eg. VANCOUVER BC  V6T 2A3.
  29.  
  30. If the address cannot be read by the OCR machine, the letter is routed to a 
  31. clerk who tries to read your writing and applies a fluorescent barcode to the 
  32. bottom of the letter for subsequent sorting.
  33.  
  34. Canada Post is moving to a barcode system, which will encode the entire 
  35. address including apartment and street numbers. I don't have any information 
  36. on this system.
  37.  
  38. This program compiles in FORTRAN-77 under VAX-VMS. I make no apologies and 
  39. offer no guarantees. Anyone is free to distribute, modify, improve, etc. this 
  40. program.
  41.  
  42. --
  43.  Andrew Daviel, Vancouver, Canada
  44.  
  45. --- cut here ---
  46.     program pcode
  47. c    program to write postcode graphics on HP Laserjet
  48.     implicit none
  49.  
  50.     integer j,k,x0,y0,x1,y1,x2,y2,naddress,nraddress,nc,ll,fl,i
  51.     real dx,dy,scale
  52.     integer ama
  53.  
  54.     data x2,y2 /1000,3000/    ! positon for postcode
  55.     integer kv(7)
  56.     logical invalid, do_raddress/.true./
  57.     integer maxa
  58.     parameter (maxa=10)
  59.     character*7 postcode ,rpostcode
  60.     character*60 address(maxa),filename, raddress(maxa), lines(maxa)
  61.  
  62.     character*1 esc,block,cr,lf,ch
  63. c    block is a solid character in IBM-US font
  64.     parameter (esc=char(27),block=char(221),cr=char(13),lf=char(10))
  65.     character*2 pfix,sfix
  66.  
  67.  
  68.     data pfix(1:1),pfix(2:2) /esc,'P'/ ! prefix & suffix to protect escape 
  69.     data sfix(1:1),sfix(2:2) /esc,'\'/    ! sequences from VMS
  70.  
  71.     scale=1000./1.37    ! convert inches to decipoints
  72.  
  73.     dx=scale*2.0/34.    ! x increment in postcode pattern
  74.     dy=scale*0.23        ! x increment
  75.  
  76.  
  77. c    code blocks are 42mm from bottom of envelope, 27mm from right
  78.  
  79.     x0=scale * 7.56
  80.     y0=scale * 4.16    ! position of code blocks wrt. top left (inches)
  81.  
  82.     x1=scale * 7.8
  83.     y1=scale * 2.34    ! position of bars wrt. top left
  84.  
  85.     ama=ichar('A')-ichar('a')
  86.  
  87. 9    type *,'Enter filename of letter to get address'
  88.     accept 1,filename
  89.  
  90. c    obtain address from file, assuming it is top-left justified and
  91. c    terminated by a blank line, and that postcode is last line of
  92. c    address
  93.  
  94.     open(unit=1,status='old',file=filename,err=9)
  95.     k=1
  96. 10    read(1,11) nc,address(k)
  97. 11    format(q,a)
  98.     if ((nc.eq.0..or.address(k)(1:7).eq.' ').and.k.eq.1) goto 10
  99. c    convert address to upper case
  100.     do j=1,nc
  101.     if (address(k)(j:j).le.'z'.and.address(k)(j:j).ge.'a') 
  102.     1 address(k)(j:j)=char(ichar(address(k)(j:j))+ama)
  103.     enddo
  104.     k=k+1
  105.     if (nc.gt.0.or.address(k-1)(1:7).ne.' ') goto 10
  106.     naddress=k-2
  107.  
  108.  
  109.     if (do_raddress) then
  110. c    look for a return address, left justified at bottom
  111. c    of letter, preceded by a blank line
  112.  
  113. c      read remainder of letter into ring buffer,     
  114.       k=1
  115. 20      read(1,11,end=25) nc,lines(k)
  116.       k=k+1
  117.       if (k.gt.maxa) k=1
  118.       goto 20
  119.  
  120. 25      ll=k-1    ! last line of return address
  121.       if (ll.eq.0) ll=maxa 
  122. 31      if (lines(ll)(1:7).ne.' ') goto 32
  123.       ll=ll-1
  124.       if (ll.eq.0) ll=maxa 
  125.       if (ll.eq.k) goto 32
  126.       goto 31
  127.  
  128. 32      k=ll
  129. 26      if (lines(k)(1:7).eq.' ') goto 30
  130.       k=k-1
  131.       if (k.eq.0) k=maxa
  132.       if (k.eq.ll) goto 30
  133.       goto 26
  134.  
  135. 30      fl=k+1    ! first line of return address
  136.       if (fl.gt.maxa) fl=1
  137.       i=1
  138.       k=fl
  139. 27      continue
  140. c      convert return address to upper case
  141.       do j=1,60
  142.       if (lines(k)(j:j).le.'z'.and.lines(k)(j:j).ge.'a') then
  143.         raddress(i)(j:j)=char(ichar(lines(k)(j:j))+ama)
  144.       else
  145.         raddress(i)(j:j)=lines(k)(j:j)
  146.       endif
  147.       enddo
  148.       if (k.eq.ll) goto 28
  149.       k=k+1
  150.       if (k.gt.maxa) k=1
  151.       i=i+1
  152.       goto 27
  153. 28      nraddress=i
  154.  
  155.  
  156. c      verify postcode in return address just for the hell of it.
  157. c      initally, try for a postcode on last line
  158.       rpostcode=raddress(nraddress)(1:7)
  159.       call validate(rpostcode,kv,invalid)
  160.  
  161.       if (invalid) then
  162. c        try for a postcode on penultimate line (preceded by 2 spaces)
  163.         k=index(raddress(nraddress-1),'  ')
  164.         if (raddress(nraddress-1)(k+2:k+2).ne.' ') then
  165.         rpostcode=raddress(nraddress-1)(k+2:k+9)
  166.         call validate(rpostcode,kv,invalid)
  167.         endif
  168.         if (invalid) then
  169. c          try for a postcode on last line (preceded by 2 spaces)
  170.           k=index(raddress(nraddress),'  ')
  171.           if (raddress(nraddress)(k+2:k+2).ne.' ') then
  172.           rpostcode=raddress(nraddress)(k+2:k+9)
  173.           call validate(rpostcode,kv,invalid)
  174.           endif
  175.         endif ! invalid
  176.       endif ! invalid
  177.  
  178.       type *,'Return address from letter:'
  179.       do k=1,nraddress
  180.       type *,raddress(k)
  181.       enddo
  182.       type *,' '
  183.       if (invalid) then
  184.         type *,'Invalid Canadian Postcode in return address"',rpostcode,'"'
  185.       else
  186.         type *,'Return address Postcode: ',rpostcode
  187.       endif
  188.       type *,' '
  189.       type *,'Print this return address (y|n) ?'
  190.       accept 13,ch
  191. 13      format(a)
  192.       do_raddress=(ch.eq.'y'.or.ch.eq.'Y')
  193.  
  194.     endif ! do_raddress
  195.  
  196. c    initally, try for a postcode on last line
  197.     postcode=address(naddress)(1:7)
  198.  
  199.     call validate(postcode,kv,invalid)
  200.  
  201.     if (invalid) then
  202. c        try for a postcode on penultimate line (preceded by 2 spaces)
  203.         k=index(address(naddress-1),'  ')
  204.         if (address(naddress-1)(k+2:k+2).ne.' ') then
  205.         postcode=address(naddress-1)(k+2:k+9)
  206.         call validate(postcode,kv,invalid)
  207.         endif
  208.         if (invalid) then
  209. c          try for a postcode on last line (preceded by 2 spaces)
  210.           k=index(address(naddress),'  ')
  211.           if (address(naddress)(k+2:k+2).ne.' ') then
  212.           rpostcode=address(naddress)(k+2:k+9)
  213.           call validate(postcode,kv,invalid)
  214.           endif
  215.         endif ! invalid
  216.     endif
  217.  
  218.     type *,'Mailing address from letter:'
  219.     do k=1,naddress
  220.     type *,address(k)
  221.     enddo
  222.     type *,' '
  223.     if (invalid) then
  224.         type *,'Invalid Canadian Postcode "',postcode,'"'
  225.     else
  226.         type *,'Address Postcode: ',postcode
  227.     endif
  228.  
  229.  
  230.     open(unit=2,carriagecontrol='list',status='new',file='envelope.')
  231.  
  232. c    reset, manual envelope, landscape
  233.     write (2,1) pfix//esc//'E'//esc//'&l3H'//esc//'&l1O'//sfix
  234. 1    format(a)
  235.     write(2,1) pfix//esc//'(10U'//sfix    ! IBM-US set
  236.  
  237.     if (.not.invalid) then
  238. c        print vertical bars
  239.         do j=0,3
  240.         do k=0,3
  241.         call ink(x1+nint(j*0.12*scale),y1+nint(k*0.14*scale))
  242.         enddo
  243.         enddo
  244. c        print 6 bounding blocks
  245.         do j=0,2
  246.         call ink2(x0,y0+nint(j*dy))
  247.         call ink2(x0+nint(34.*dx),y0+nint(j*dy))
  248.         enddo
  249. c        print postcode blocks
  250.         call ink2(x0+nint((1+kv(1))*dx),y0)
  251.         call ink2(x0+nint((1+kv(2))*dx),y0)
  252.         call ink2(x0+nint((1+kv(3))*dx),y0+nint(dy))
  253.         call ink2(x0+nint((1+kv(5))*dx),y0+nint(dy))
  254.         call ink2(x0+nint((1+kv(6))*dx),y0+nint(2.0*dy))
  255.         call ink2(x0+nint((1+kv(7))*dx),y0+nint(2.0*dy))
  256. c        call plot(x2,y2,postcode)
  257.     endif
  258.  
  259. c    address must be 40mm from top, 25mm from left, 19mm from bottom
  260. c    postcode must be within (26+19mm) from bottom
  261.  
  262. c    set top margin, left margin for address (lines/characters)
  263.     write(2,1) pfix//esc//'&l24E'//esc//'&a40L'//sfix ! was 24, 26
  264. c    move to top left
  265.     write(2,1) pfix//esc//'&a0H'//esc//'&a0V'//sfix//CR
  266.     do k=1,naddress
  267.     write(2,1) address(k)//cr//lf
  268.     enddo
  269.  
  270.     if (do_raddress) then
  271. c      set top, left margin for return address
  272.       write(2,1) pfix//esc//'&l15E'//esc//'&a20L'//sfix 
  273.       write(2,1) pfix//esc//'&a0H'//esc//'&a0V'//sfix//CR
  274. c      ISO 6 font, 16 pitch 12 point, italic, bold stroke, Courier
  275.       write(2,1) pfix//esc//'(0U'//esc//'(s0p16h12v1s3b3T'//esc//
  276.     1 '&l8D'//sfix//CR
  277.       write(2,1) 'From:'//cr//lf
  278.  
  279. c      ISO 6 font, 16 pitch 12 point, upright, medium stroke, Courier
  280.       write(2,1) pfix//esc//'(0U'//esc//'(s0p16h12v0s0b3T'//esc//
  281.     1 '&l8D'//sfix//CR
  282.  
  283.       do k=1,nraddress
  284.       write(2,1) raddress(k)//cr//lf
  285.       enddo
  286.     endif
  287.  
  288.     write (2,1) pfix//esc//'E'//sfix ! reset
  289.     type *,'Use HPRINT ENVELOPE. P to print' ! passall print command
  290.     end
  291. c---
  292.     subroutine ink(x,y)
  293.     implicit none
  294.     integer x,y,y2,k
  295.  
  296.     character*1 esc,block,ch,block2
  297.     parameter (esc=char(27),block=char(221),block2=char(254))
  298.     character*2 pfix,sfix
  299.  
  300.     data pfix(1:1),pfix(2:2) /esc,'P'/ ! prefix & suffix to protect escape 
  301.     data sfix(1:1),sfix(2:2) /esc,'\'/    ! sequences from VMS
  302.  
  303.     character*4 cx,cy
  304.     character*7 code
  305.  
  306.     ch=block
  307.  
  308.     write(cx,1) x
  309. 1    format(i4.4)
  310.     write(cy,1) y
  311.     write(2,2) pfix//esc//'&a'//cx//'H'//esc//'&a'//cy//'V'//sfix//ch
  312. 2    format(a)
  313.     return
  314.  
  315.     entry plot(x,y,code)
  316.     write(cx,1) x
  317.     write(cy,1) y
  318.     write(2,2) pfix//esc//'&a'//cx//'H'//esc//'&a'//cy//'V'//sfix//code
  319.     return
  320.  
  321.     entry ink2(x,y)
  322.     write(cx,1) x
  323.     ch=block2
  324.  
  325.     do k=0,4
  326.     y2=y+k*17    ! 0.6mm /25.4 * 1000/1.37
  327.     write(cy,1) y2
  328.     write(2,2) pfix//esc//'&a'//cx//'H'//esc//'&a'//cy//'V'//sfix//ch
  329.     enddo
  330.  
  331.     return
  332.     end
  333. c--
  334.     subroutine validate(postcode,kv,invalid)
  335.     implicit none
  336.  
  337.     character*7 postcode 
  338.     logical invalid
  339.     character*31 validcode
  340.     data validcode /'ABCEGHJKLMNPRSTVWXYZ_0123456789'/
  341.     integer k
  342.     integer kv(7)
  343.  
  344. c==
  345.     invalid=.false.
  346.     do k=1,7
  347.     kv(k)=index(validcode,postcode(k:k))
  348.     if (k.eq.4) then
  349.         if (postcode(4:4).ne.' ') then
  350.         invalid=.true.
  351. c        type *,'Invalid character ',postcode(k:k),' at position',k    
  352.         endif
  353.     elseif (kv(k).eq.0) then
  354. c        type *,'Invalid character ',postcode(k:k),' at position',k
  355.         invalid=.true.
  356.     endif
  357.     enddo
  358.  
  359.     return
  360.     end
  361.  
  362.