home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / envelope.icn < prev    next >
Text File  |  2000-07-29  |  6KB  |  192 lines
  1. ############################################################################
  2. #
  3. #    File:     envelope.icn
  4. #
  5. #    Subject:  Program to address envelopes
  6. #
  7. #    Author:   Ronald Florence
  8. #
  9. #    Date:     August 14, 1996
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #    Version:  1.1
  18. #
  19. ############################################################################
  20. #  
  21. #  This program addresses envelopes on a Postscript or HP-LJ printer,
  22. #  including barcodes for the zip code.  A line beginning with `#' or
  23. #  an optional alternate separator can be used to separate multiple
  24. #  addresses.  The parser will strip the formatting commands from an
  25. #  address in a troff or LaTeX letter.
  26. #
  27. #  usage: envelope [options] < address(es)
  28. #  
  29. #  Typically, envelope is used from inside an editor.  In emacs, mark
  30. #  the region of the address and do
  31. #    M-| envelope 
  32. #  In vi, put the cursor on the first line of the address and do
  33. #    :,+N w !envelope 
  34. #  where N = number-of-lines-in-address.  
  35. #
  36. #  The barcode algorithm is adapted from a perl script by Todd Merriman
  37. #  <todd@toolz.uucp>, Dave Buck <dave@dlb.uucp>, and Andy Rabagliati
  38. #  <andyr@wizzy.com>.
  39. #
  40. ############################################################################
  41. #
  42. #  Links: options
  43. #
  44. ############################################################################
  45.  
  46. link options
  47. global Printertype
  48.  
  49. procedure main(arg)
  50.   local opts, lp, separator, printerinit, printerclear, 
  51.     hpinit, hppos, xorigin, yorigin, rotate, font, 
  52.     prn, addr, psprefix, preface, optstr, usage, goodline
  53.  
  54.   usage := ["usage: envelope [options] < address(es)",
  55.         "\t-p | -postscript",
  56.         "\t-h | -hplj",
  57.         "\t-l | -printer spooler-program",
  58.         "\t-s | -separator string",
  59.         "\t-i | -init  printer-init",
  60.         "\t-c | -clear printer-clear",
  61.         "\t-f | -font fontname    [Postscript only]",
  62.         "\t-x | -xorigin xorigin  [Postscript only]",
  63.         "\t-y | -yorigin yorigin  [Postscript only]",
  64.         "\t-r | -rotate rotation  [Postscript only]",
  65.         "\t-hpinit string  [hplj only]",
  66.         "\t-hppos  string  [hplj only]" ]
  67.   psprefix := ["%! Postscript",
  68.                "/adline { 10 y moveto show /y y 13 sub def } def",
  69.                "/barcode {",
  70.                "  /y y 13 sub 0.72 div def",
  71.                "  0.72 dup scale 2 setlinewidth",
  72.                "  /x 100 def",
  73.                "  /next { x y moveto /x x 5 add def } def",
  74.                "  /S { next 0 5 rlineto stroke } def",
  75.                "  /L { next 0 12 rlineto stroke } def } def",
  76.                "/newenvelope {",
  77.                "  /y 80 def" ]
  78.   optstr := "hpl:f:r+i:c:x+y+s:?"
  79.   optstr ||:= "-help!-printer:-hpinit:-hppos:-postscript!:-font:-hplj!"
  80.   optstr ||:= "-rotate+-xorigin+-yorigin+-init:-clear:-separator:"
  81.   opts := options(arg, optstr)
  82.   \opts["?"|"help"] | arg[1] == "?" & { 
  83.     every write (!usage)
  84.     exit (-1)
  85.   }
  86.                     # change defaults below as needed
  87.   Printertype :=                 "hplj"
  88.   lp := \opts["l"|"printer"] |            "lpr"
  89.   separator := \opts["s"|"separator"] |        "#"
  90.   printerinit := \opts["i"|"init"] |              ""
  91.   printerclear := \opts["c"|"clear"] |        ""
  92.                     # the next four are Postscript-only
  93.   xorigin := \opts["x"|"xorigin"] |        200           
  94.   yorigin := \opts["y"|"yorigin"] |        400
  95.   rotate := \opts["r"|"rotate"] |        90
  96.   font := \opts["f"|"font"] |            "Palatino-Bold"
  97.                     # these two are hplj-only
  98.                     # comm. env., manual feed, landscape
  99.   hpinit := \opts["hpinit"] |            "\33&k2G\33&l81a3h1O"
  100.   hppos := \opts["hppos"] |            "\33&a40L\33*p550Y"
  101.  
  102.   \opts["h"|"hplj"] & Printertype := "hplj"
  103.   \opts["p"|"postscript"] & Printertype := "postscript"
  104.   if "pipes" == &features then prn := open(lp, "pw")
  105.   else if "MS-DOS" == &features then prn := open ("PRN", "w")
  106.   else stop ("envelope: please configure printer")
  107.   writes(prn, printerinit)
  108.  
  109.   if map(Printertype) == "postscript" then {
  110.     every write(prn, !psprefix)
  111.     write(prn, "  ", xorigin, " ", yorigin, " translate ", rotate, " rotate")
  112.     write(prn, "  /", font, " findfont 12 scalefont setfont } def")
  113.     preface := "newenvelope\n"
  114.   }
  115.   else preface := hpinit || hppos
  116.   addr := []
  117.   every !&input ? {
  118.                 # filter troff junk
  119.     =(".DE" | ".fi") & break
  120.     if =(".DS" | ".nf") then tab(0)
  121.                 # multiple addresses with separators
  122.     if =separator then {
  123.       (*addr > 0) & address(addr, prn, preface) 
  124.       addr := []
  125.       tab(0)
  126.     }
  127.                 # filter LaTeX junk
  128.     else {
  129.       if ="\\begin" then { 
  130.     every tab(upto('{')+1) \2
  131.     goodline := clean(tab(0), '\\')
  132.       }
  133.       else goodline := clean(tab(0), '\\')
  134.       put(addr, trim(goodline, ' }'))
  135.     }
  136.   }
  137.   (*addr > 0) & address(addr, prn, preface)
  138.   writes(prn, printerclear)
  139. end
  140.  
  141.  
  142. procedure address(addr, prn, preface)
  143.   local zip, zline
  144.  
  145.   zip := ""
  146.   writes(prn, preface)
  147.   every !addr ? 
  148.     if map(Printertype) == "postscript" then 
  149.       write(prn, "(", tab(0), ") adline")
  150.     else write(prn, tab(0))
  151.                 # scan for zipcode
  152.   while *(zline := trim(pull(addr))) = 0
  153.   reverse(zline) ? if many(&digits++'-') = (6|11) then
  154.       while tab(upto(&digits)) do zip ||:= tab(many(&digits))
  155.   (*zip = (5|9)) & barcode(reverse(zip), prn)
  156.   if map(Printertype) == "postscript" then write(prn, "showpage")
  157.   else writes(prn, "\33E")
  158. end
  159.  
  160.  
  161. procedure barcode(zip, prn)
  162.   local z, zipstring, cksum, bar
  163.  
  164.   cksum := 0
  165.   every cksum +:= !zip
  166.   zip := zip || (100 - cksum) % 10
  167.   bar := ["LLSSS", "SSSLL", "SSLSL", "SSLLS", "SLSSL", 
  168.       "SLSLS", "SLLSS", "LSSSL", "LSSLS", "LSLSS" ]
  169.                 # The barcode is wrapped in long marks
  170.   zipstring := "L"
  171.                 # Icon lists are indexed from 1
  172.   every z := !zip do zipstring ||:= bar[z + 1]
  173.   zipstring ||:= "L"
  174.   if map(Printertype) == "postscript" then write(prn, "barcode")
  175.   else writes(prn, "\33*p990y1575X\33*c6A")    
  176.   every !zipstring ? 
  177.     if map(Printertype) == "postscript" then write(prn, tab(0))
  178.     else {
  179.       if =("S") then writes(prn, "\33*p+21Y\33*c15b0P\33*p-21Y")
  180.       else writes(prn, "\33*c36b0P")
  181.       writes(prn, "\33*p+15X")
  182.     }
  183. end
  184.  
  185.  
  186. procedure clean(s, c)
  187.   local i
  188.  
  189.   while i := upto(c, s) do s[i:many(c,s,i)] := ""
  190.   return s
  191. end
  192.