Xref: utzoo comp.lang.perl:3216 alt.sources:2681
Path: utzoo!utgpu!cs.utexas.edu!wuarchive!emory!att!linac!midway!gargoyle!chinet!les
From: les@chinet.chi.il.us (Leslie Mikesell)
Newsgroups: comp.lang.perl,alt.sources
Subject: nametag.pl
Summary: generate postscript nametags from list
Message-ID: <1990Dec04.185336.4946@chinet.chi.il.us>
Date: 4 Dec 90 18:53:36 GMT
Organization: Chinet - Public Access UNIX
Lines: 209


I haven't been able to find a generic mail-merge routine that forces
the merged text to fit into certain spaces, so I wrote this...

This program generates postscript code for nametags with the text
centered and scaled to fit into the appropriate spots (for our
nametag stock).  I normally run it as part of a spooler printer
interface program, but it can be run as a stand-alone operation.

Bugs:
It should probably read a parameter file to get the positioning info,
but with an interpreted language it is just as easy to edit the
script - at least for the person who wrote it.
The whole operation could doubtlessly be done in postscript
by someone with a stack-oriented brain.  In retrospect it was a bad
idea to try to hit a pre-printed bar exactly (although the color
does give a nice effect).  I've had to adjust the $YSLIDE variable
as much as 12 points to compensate for different printers.
---
Les Mikesell
  les@chinet.chi.il.us   or  les@fb.com

# ---- cut here --------
# nametag.pl
# Perl program to generate postscript program....
# execute with:
# perl nametag.pl file...
#    or pass the input on stdin - output is to stdout
# This is set up for pre-printed nametag stock 2 across, 3 down
# with a logo at the top and a red bar near the bottom on each, 
# but it should work to change the constants for other layouts.
#
# print nametags from files in format:
# line1|line2|line3|line4|line5
# ...  (each line contains the data for one nametag, up to 5 lines
#       using "|" as the delimiter for lines on the tag)
#  
# if line2 is empty, line3 moves up
# line4 prints in 14 pt italic just above red bar
# line5 lands on red bar (red bar refers to a position near the bottom)
#
#  blank lines are ignored
#  a form-feed in the file ejects the current page (for easier
#    grouping for distribution)
#  otherwise pages are filled (6/page) until the end of file is reached
#
#  Procedure tline:
#   Fonts are selected by first attempting ch1 (choice 1 below) in its
#   specified size.  If it is too wide, an attempt is made using ch2.
#   If it still doesn't fit, ch2 is rescaled to make it fit.
#   Iline does the same with fonts ch3 and ch4 for italics.
# starting point size is imbedded in the perl code:
# 24pt for lines 1,2,3, 14 pt for line 4, 20 pt for line 5
# 

# ---- positioning info -----
# column layout
$COLS=2 ;
$ROWS=3 ;
# -- these numbers are postscript units --
# -- adjust this number for vertical allignment --
$YSLIDE= 1; # may need to tweak for printer

# -- starting points -- 
$X1=25;    # indent to 1st printing posn
$Y1=687 + $YSLIDE ;   # top line vertical posn
$Y4=601 + $YSLIDE ;   # above red bar
$Y5=572 + $YSLIDE ;   # red bar
$DX=286;   # add for 2nd col
$DY=264;   # sub for 2nd, 3rd rows
$LINE=30;  # sub for 2nd,3rd lines
$WIDTH = $DX -10; # max space to fill
# ----
# This is the postscript header with some definitions
# -- ch1 def sets first font choice, ch2 is used if 1st attempt is too wide
# -- likewise ch3 & ch4 for italics
$HD='%!
% 1st, 2nd tries for tline
/ch1 { /Helvetica-Bold findfont exch scalefont setfont} def
/ch2 { /Helvetica-Narrow-Bold findfont exch scalefont setfont} def
% 1st, 2nd tries for iline
/ch3 { /Helvetica-BoldOblique findfont exch scalefont setfont} def
/ch4 { /Helvetica-BoldOblique findfont exch scalefont setfont} def
%  x y width string max-pts
% pick a font that lets string fit in width (ch1, ch2 pair)
% center within the space
/tline
 {
  /pts exch def
  /str exch def
  /wd exch def
  /y1 exch def
  /x1 exch def
% try 1st choice
   pts ch1
   str stringwidth pop wd gt { 
       % did not fit - try 2nd choice font
       pts ch2
       /sw str stringwidth pop def
       sw wd gt  {
       % still did not fit - rescale
           currentfont wd sw div scalefont setfont  
       }if
    }if
    % center within space and print
    wd str stringwidth pop sub 2 div x1 add y1 moveto str show
    }def

%  x y width string max-pts
% same w/italic font (ch3, ch4 choices)
% center within the space
/iline
 {
  /pts exch def
  /str exch def
  /wd exch def
  /y1 exch def
  /x1 exch def
% try 1st choice
   pts ch3
   str stringwidth pop wd gt { 
       % did not fit - try 2nd choice font
       pts ch4
       /sw str stringwidth pop def
       sw wd gt  {
       % still did not fit - rescale
           currentfont wd sw div scalefont setfont  
       }if
    }if
    % center within space and print
    wd str stringwidth pop sub 2 div x1 add y1 moveto str show
    }def

';

$CCOL=-1;
$CROW=0;

printf "%s",$HD;  #postscript program
$NEWPAGE=1;
$NPAGE=0;
while (<>) {      # read input line 
    if (/\f/) {   # go to different page
        $NEWPAGE = 1;  
        s/\f//;   # likely not to be a newline after formfeed
    }
    s/\r//;       # ignore carriage returns
    chop;         # remove linefeed
    if (/^ *$/) { next;}  # skip blank lines
    # "(" in text must be "\(" in postscript output
    s/\\/\\\\/g;    # I hate it when this happens...
    s/\(/\\(/g; 
    s/\)/\\)/g;
#
#    print $CCOL;   #..for debugging only
#    print "\n";
#    print $CROW;
#    print "\n";
    if ($NEWPAGE > 0) {   # starting a page
      $CCOL = $COLS -1;
      $CROW = $ROWS -1;
    }
    if (++$CCOL == $COLS) {
        $CCOL = 0;
        if (++$CROW == $ROWS) {
        $CROW = 0;
        if ($NPAGE++ > 0 ) {
            printf "%s\n","showpage";      # eject previous page
        }
            printf "%% page %d\n",$NPAGE;  # sometimes handy to know
        $NEWPAGE = 0;
        }
    }
    # calc x y coordinates for this one
    $LX = $X1 + $CCOL * $DX;
    $LY1 = $Y1 - $CROW * $DY;
    $LY2 = $LY1 - $LINE;
    $LY3 = $LY2 - $LINE;
    $LY4 = $Y4 - $CROW * $DY;
    $LY5 = $Y5 - $CROW * $DY;
    # break item into lines 
     @LINE=split(/\|/);
    if ($LINE[1] eq "" ) {
        $LY3 = $LY2; # close up if line 2 is blank
    }
    # print the non-blank lines - the number is the initial point size
    # tline uses helvetica, iline is italic
    if ($LINE[0] ne "" ) {
        printf "%d %d %d (%s) 24 tline \n",$LX,$LY1,$WIDTH,$LINE[0] ;
    }
    if ($LINE[1] ne "" ) {
        printf "%d %d %d (%s) 24 tline \n",$LX,$LY2,$WIDTH,$LINE[1] ;
    }
    if ($LINE[2] ne "" ) {
        printf "%d %d %d (%s) 24 tline \n",$LX,$LY3,$WIDTH,$LINE[2] ;
    }
    if ($LINE[3] ne "" ) {
        printf "%d %d %d (%s) 14 iline \n",$LX,$LY4,$WIDTH,$LINE[3] ;
    }
    if ($LINE[4] ne "" ) {
        printf "%d %d %d (%s) 20 tline \n",$LX,$LY5,$WIDTH,$LINE[4] ;
    }
}

printf "%s\n%% end of page %d\n","showpage",$NPAGE;
# you may or may not need a control-D here, depending on whether
# or not something else handles postscript EOF
# uncomment the next line if you need it
# print "\004";


Brought to you by Super Global Mega Corp .com