[net.sources] upc fonts

patwood@unirot.UUCP (03/28/87)

I hope this doesn't get screwed up and posted twice...

The following shar is a PostScript UPC font and a shell program for
generating UPC labels.  Since I don't yet have a barcode reader, I'm
interested in knowing whether these fellows work.  The bar codes look
correct to the naked eye, but we all know that means nothing to a bar
code reader.  If anyone out there can, let me know if this all works.
If not, please send me your modifications or post to the net.

Pat Wood
{ihnp4,harpo,seismo}!bellcore!phw5!phw
-----------------------------cut here-----------------------------
# To recover, type "sh archive"
echo restoring upc
sed 's/^X//' > upc <<\XxXxXxXxXx-EOF-XxXxXxXxXx
X#!/bin/sh
X# upc -- print upc code with PostScript
X# usage:  upc prod code-5 code-5
X# prod is the product type (zero for store items)
X# code-5 is a five digit code (needs two of these)
X
X# Copyright (C) 1986 by Pipeline Associates, Inc.
X# Permission is granted to use and distribute as long as this copyright
X# notice remains intact and it is distributed free of charge.
X
XUPCFONT=./upc.pro
XX=1	# x coordinate of lower right corner (in inches)
XY=1	# x coordinate of lower right corner (in inches)
X
X# calculate checksum
Xsum=`echo "$2
X$3
X$2
X$3" | sed "
X	1s/\(.\)\(.\)\(.\)\(.\)\(.\)/a=$1 + \2 + \4/
X	2s/\(.\)\(.\)\(.\)\(.\)\(.\)/b=\1 + \3 + \5/
X	3s/\(.\)\(.\)\(.\)\(.\)\(.\)/c=\1 + \3 + \5/
X	4s/\(.\)\(.\)\(.\)\(.\)\(.\)/s=(a+b)*3+c+\2+\4;(10-(s%10))%10/" | bc`
X
Xcat $UPCFONT
Xecho "$X 72 mul $Y 72 mul translate /UPC findfont 50 scalefont setfont
X0 0 moveto
X(| |$1$2 | | ) show
Xswitch
X($3$sum) show
Xswitch
X(| |) show
Xshowpage"
XxXxXxXxXx-EOF-XxXxXxXxXx
echo restoring upc.pro
sed 's/^X//' > upc.pro <<\XxXxXxXxXx-EOF-XxXxXxXxXx
X%%
X%%  Universal Product Code font
X%%  Copyright (C) 1986 by Pipeline Associates, Inc.
X%%  Permission is granted to use and distribute as long as this copyright
X%%  notice remains intact and it is distributed free of charge.
X%%
X/UPCFontDict 8 dict def
X/workdict 25 dict def
X%% load up drawing procedures
Xworkdict begin
X	/gray 0 def
X	/d1 {
X		1.3 setlinewidth
X		1 0 moveto 1 100 lineto stroke
X		2 0 translate
X	} bind def
X	/d2 {
X		3.3 setlinewidth
X		2 0 moveto 2 100 lineto stroke
X		4 0 translate
X	} bind def
X	/d3 {
X		5.3 setlinewidth
X		3 0 moveto 3 100 lineto stroke
X		6 0 translate
X	} bind def
X	/d4 {
X		7.3 setlinewidth
X		4 0 moveto 4 100 lineto stroke
X		8 0 translate
X	} bind def
X	/cline1 {
X		1 gray sub setgray
X		d1
X	} bind def
X	/cline2 {
X		1 gray sub setgray
X		d2
X	} bind def
X	/cline3 {
X		1 gray sub setgray
X		d3
X	} bind def
X	/cline4 {
X		1 gray sub setgray
X		d4
X	} bind def
X	/line1 {
X		gray setgray
X		d1
X	} bind def
X	/line2 {
X		gray setgray
X		d2
X	} bind def
X	/line3 {
X		gray setgray
X		d3
X	} bind def
X	/line4 {
X		gray setgray
X		d4
X	} bind def
Xend
X/switch {
X	workdict begin /gray 1 gray sub def end
X	} def
X
XUPCFontDict begin
X/FontType 3 def
X/FontMatrix [.01 0 0 .015 0 0] def
X/FontBBox [0 0 10 100] def
X/Encoding 128 array def
X/Widths 128 array def
X
X%% fill the Encoding array with the procs to run for each character
X0 1 127 {Encoding exch /.notdef put} for
XEncoding (0) 0 get /zero put
XEncoding (1) 0 get /one put
XEncoding (2) 0 get /two put
XEncoding (3) 0 get /three put
XEncoding (4) 0 get /four put
XEncoding (5) 0 get /five put
XEncoding (6) 0 get /six put
XEncoding (7) 0 get /seven put
XEncoding (8) 0 get /eight put
XEncoding (9) 0 get /nine put
XEncoding ( ) 0 get /space put
XEncoding (|) 0 get /bar put
X
XWidths (0) 0 get 14 put
XWidths (1) 0 get 14 put
XWidths (2) 0 get 14 put
XWidths (3) 0 get 14 put
XWidths (4) 0 get 14 put
XWidths (5) 0 get 14 put
XWidths (6) 0 get 14 put
XWidths (7) 0 get 14 put
XWidths (8) 0 get 14 put
XWidths (9) 0 get 14 put
XWidths ( ) 0 get 2 put
XWidths (|) 0 get 2 put
X
X%% define the procs
X/CharProcs 20 dict def
XCharProcs /.notdef {} put
XCharProcs /zero {
X	cline3 line2 cline1 line1
X} put
XCharProcs /one {
X	cline2 line2 cline2 line1
X} put
XCharProcs /two {
X	cline2 line1 cline2 line2
X} put
XCharProcs /three {
X	cline1 line4 cline1 line1
X} put
XCharProcs /four {
X	cline1 line1 cline3 line2
X} put
XCharProcs /five {
X	cline1 line2 cline3 line1
X} put
XCharProcs /six {
X	cline1 line1 cline1 line4
X} put
XCharProcs /seven {
X	cline1 line3 cline1 line2
X} put
XCharProcs /eight {
X	cline1 line2 cline1 line3
X} put
XCharProcs /nine {
X	cline3 line1 cline1 line2
X} put
XCharProcs /space {
X} put
XCharProcs /bar {
X	line1
X} put
X%% BuildChar is called by PS whenever a character is to be imaged out
X%% of UPC
X/BuildChar {
X workdict begin
X  /char exch def
X  /fontdict exch def
X  /charname fontdict /Encoding get char get def
X  /charproc fontdict /CharProcs get charname get def
X  /charwidth fontdict /Widths get char get def
X  charwidth 0 setcharwidth
X  gsave
X	charproc
X  grestore
X end
X} bind def
Xend
X%% register font in postscript font machinery
X/UPC UPCFontDict definefont pop
XxXxXxXxXx-EOF-XxXxXxXxXx