diff options
author | Karl Berry <karl@freefriends.org> | 2007-08-07 00:24:50 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2007-08-07 00:24:50 +0000 |
commit | 19de762b4dff70b0b8ead478b4681b72d2f89853 (patch) | |
tree | acd2d14f3bd77a2ce67cb77bdd0b83ea840375b6 /Master/texmf-dist/doc/latex/barcodes/codean.pl | |
parent | e99436b7d536daca535a24df43d78f648c5a01fc (diff) |
barcodes from CTAN
git-svn-id: svn://tug.org/texlive/trunk@4706 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/doc/latex/barcodes/codean.pl')
-rw-r--r-- | Master/texmf-dist/doc/latex/barcodes/codean.pl | 492 |
1 files changed, 492 insertions, 0 deletions
diff --git a/Master/texmf-dist/doc/latex/barcodes/codean.pl b/Master/texmf-dist/doc/latex/barcodes/codean.pl new file mode 100644 index 00000000000..0e3cd010158 --- /dev/null +++ b/Master/texmf-dist/doc/latex/barcodes/codean.pl @@ -0,0 +1,492 @@ +# your shell command goes here +# +# Hacking EAN numbers to a form usable with WLEAN.MF. +# +# September 3, 1997 +# Peter Willadt +# +# Added hacking any text for coding with code 128 +# 1998-01-24 +# +# Added checksumming for code 93 +# 1998-11-29 +# +# 2003-05-24 +# cleaned up the code in several places and +# corrected code 93 checksumming due to a hint by +# Jacek Ruzyczka <uv_centcom@yahoo.com> +# +# 2003-05-24 +# removed an error introduced the same day +# +# This file is free to use without any further permissions. +# This file comes with no warranty of any kind. +# +# The TeX file to be filtered may contain any number of lines +# that have one of the following commands +# starting at the leftmost position. +# +# \ean{12 or 13 digit number} +# the number gets coded as EAN, +# if it is only 12 digits long, the checksum gets calculated +# +# \embed{number} +# the number is used as a base for embedding article numbers & c. +# \eean{number} +# a number to be embedded with an ean. +# +# \isbn{number} +# an isbn to make an embedded ean of. +# +# \cxxviii{any 7 bit ascii values} +# code as barcode 128 (see rules below!) +# +# \xciii{uppercase text or number} +# text to be coded as code 128 +# +# example: +# You want the isbn 0-201-13448-9 to be embedded. +# so you say \isbn{0201134489}, +# but you may also say \embed{9780000000000} and, +# somewhere later in the file, \eean{020113448} +# In this case you have to leave the last digit out, +# as isbn loose their check digit in favour of the +# ean check digit. +# anyway you do it, you get your command replaced by +# \EAN{13-digit-number-coded-strange} +# in the output file. +# +# +# code 128 rules: +# you write a line starting with \cxxviii{ +# followed by arbitrary 7 bit characters, delimited by a right brace}. +# as perl is greedy, it will be the rightmost right brace (no fence matching), +# but as perl is also nice, you will be warned if there is another +# right brace. Please note that even the percent character % will be +# included. So it is better to write the \cxxviii{...} statement onto +# a line of its own. You may replace any character by ^^00 and +# similiar codes, preferably you will do this to non-printable ascii +# characters, or right braces and the like. This routine will try to find +# an efficent way to make code 128 (sorry, not necessarily the most +# efficient way) out of your input and then it will +# insert a line like \CXXVIII{3a 70 12 ... @@} in the output file. +# The code 128 special characters can be included by the following codes: +# ^^80 FNC3 +# ^^81 FNC2 +# ^^82 SHIFT +# ^^83 CODE C/CODE C/99 +# ^^84 CODE B/FNC4/CODE B +# ^^85 FNC4/CODE A/CODE A +# ^^86 FNC1 +# ^^87 START A +# ^^88 START B +# ^^89 START C +# ^^8a STOP + +use strict; + +use vars qw ( @ABTAB $ifname $ofname ); +# code switch table for ean + +@ABTAB=(0,0,0,0,0,0, #0 + 0,0,1,0,1,1, #1 + 0,0,1,1,0,1, #2 + 0,0,1,1,1,0, #3 + 0,1,0,0,1,1, #4 and so on + 0,1,1,0,0,1, + 0,1,1,1,0,0, + 0,1,0,1,0,1, + 0,1,0,1,1,0, + 0,1,1,0,1,0, + ); + +# command line processing: Need input file + +if($ARGV[0]){ + $ifname=$ARGV[0]; +}else{ + print "Enter name of file to be processed: "; + $ifname = <>; + chomp($ifname); +} + +# command line processing: need output file + +if($ARGV[1]){ + $ofname=">$ARGV[1]"; +}else{ + print "Enter name of output file: "; + $ofname = <>; + chomp($ofname); + $ofname = '>' . $ofname; +} + +# make an ean + +sub eancod{ + my ($i, $j, $checksum, $disone); + my $srcstr=shift; + # first digits first + my $precod=substr($srcstr,0,1); + # Starting output string + my $eastring=$precod . " +"; + # digits 2--7 + for($i=0;$i<6;$i++){ + my $disone=substr($srcstr,$i+1,1); + $disone =~ tr/0123456789/ABCDEFGHIJ/; + $disone= lc ($disone) if( @ABTAB[$precod*6 + $i]==1); + $eastring .=$disone; + }$eastring .= "-"; + # digits 8--13 + for($i=0;$i<6;$i++){ + # if checksum misses, do your own + if(($i==5) && (length($srcstr)==12)){ + for($j=0,$checksum=0;$j<12;$j++){ + $checksum+=substr($srcstr,$j,1)*(1+($j&1)*2); + }; + $checksum%=10; + $checksum=10-$checksum; + $checksum%=10; + $disone="$checksum"; + }else { + $disone=substr($srcstr,$i+7,1); + } + $disone =~ tr/0123456789/KLMNOPQRST/; + $eastring .=$disone; + }$eastring .="+"; + return $eastring; +} + +################################################## +# here starts the code 128 stuff +# +################################################## +# get the numerical value of a hex character, +# e.g. 65 from 41 +# +sub hexchar{ + my $src=shift; + my ($i, $j, $result); + $src =~ tr/a-f/A-F/; + $i=ord(substr($src,0,1)); + $j=ord(substr($src,1,1)); + if($i >= ord("A")){ + $i += (10-ord('A')); + }else{ + $i -= ord("0"); + } + if($j >= ord("A")){ + $j += (10-ord("A")); + }else{ + $j -= ord("0"); + } + $result=16*($i)+$j; + return $result; +} + + +# globals: +# @cxxchars holds the characters the user wants to code +# @cxxlength is the size of this array +# @ctbl holds the possible codings for these chars +# @cxxout holds the codes to be output for code 128 +# @cxxoutout holds the codes to be output for code 128 + +use vars qw ( @cxxchars $cxxlength @ctbl @cxxout @cxxoutout); + +################################################## +# build up the switching table for code 128 + +sub makectbl{ + # locals + my $i; + for($i=0;$i < $cxxlength; $i++){ + if(($cxxchars[$i] >= ord("0"))&&($cxxchars[$i] <= ord("9"))){ + # digits + $ctbl[$i]=7; + }elsif(($cxxchars[$i] >= ord(" "))&&($cxxchars[$i] <= ord("_"))){ + # common Chars + $ctbl[$i]=3; + }elsif($cxxchars[$i] < ord(" ")){ + # ascii control chars + $ctbl[$i]=1; + }elsif(($cxxchars[$i] >=ord("`"))&&($cxxchars[$i] <= ord("\x7f"))){ + # lowercase + $ctbl[$i]=2; + if($cxxchars[$i] == ord("}")){ + print "Encountered right brace in argument to cxxviii\n"; + } + }else{ # Function Codes + $ctbl[$i] =7; + } + } + $ctbl[$i]=0; # makes a stop. +} + +################################################## +# make a character array from a string +# looking like aBc\x41def^^41 or so. +# +sub unhex{ + my ($i, $j, $b); + my $srcstr=shift; + $j=0; + for($i=0;($b=ord(substr($srcstr,$i,1))) > 0;$i++){ + if($b == ord("\\")){ + if(substr($srcstr,$i+1,1) =~ /[xX]/){ # hex input + $cxxchars[$j] = hexchar(substr($srcstr,$i+2,2)); + $i += 3; + }else{ + $cxxchars[$j] = ord("\\"); + } + }elsif($b == ord("^")){ + if(ord(substr($srcstr,$i+1,1)) == ord("^")){ # hex input + $cxxchars[$j] = hexchar(substr($srcstr,$i+2,2)); + $i += 3; + }else{ + $cxxchars[$j] = ord("^"); + } + }else{ + $cxxchars[$j] = $b; + } + $j++; + } + return $j; +} + +################################################## +# write out a chunk of code 128 in hex symbols +# +sub cxxchunk{ + my $j=shift; + my ($i, $sum, $k); + $sum=7; + for($i=0;$sum & $ctbl[$j+$i]; $i++){ + $sum &= $ctbl[$j+$i]; + } + if($sum==1){ + $cxxout[$j]=101; + }else{ + $cxxout[$j]=100; + } + for($k=0;$k<$i;$k++){ + if(($sum==1)&&($cxxchars[$j+$k] < ord(" "))){ + $cxxout[$j+$k+1]=$cxxchars[$j+$k] + 64; + }else{ + $cxxout[$j+$k+1]=$cxxchars[$j+$k] - ord(" "); + } + } + $k++; + return $k; +} + +################################################## +# consecutive digits may perhaps be efficiently +# coded with charset C +# +sub pastedigits{ + my $digitcount=shift; + my $j=shift; + my $firstdigit=shift; + my $lastset=shift; + my $k; + if($digitcount==0){ # nothing to do + return $j; + }elsif($digitcount<4){ + # digits here, but unfortunately not enough digits. + # so just copy them + for($k=0;$k<$digitcount;$k++){ + $cxxoutout[$j] = $cxxout[$firstdigit+$k]; + $j++; + } + return $j; + }else{ + # is there an odd number of digits? + if(($digitcount & 1)==1){ + $cxxoutout[$j] = $cxxout[$firstdigit]; + $firstdigit++; + $digitcount--; + $j++; + }elsif(($cxxout[$j-1]>=99)&&($cxxout[$j-1]<=101)){ + # Switched immediately before digits. + # so overwrite the switch + $j--; + } + $cxxoutout[$j] = 99; # switch to set C + $j++; + # copy digits in compressed format + for($k=0;$k<$digitcount;$k+=2){ + $cxxoutout[$j] = ($cxxout[$firstdigit+$k]-16)*10 + +$cxxout[$firstdigit+$k+1]-16; + $j++; + } + # reset char set, if you have to + if($lastset > 0){ + $cxxoutout[$j] = $lastset; + $j++; + } + } + return $j; +} + +sub digitoptimize{ + # change to charset C if there are at least four numbers in a row. + # copy to @cxxoutout + my ($lastset, $firstdigit, $digitcount, $i,$j,$k); + $lastset =0; + $firstdigit=0; + $digitcount=0; + $j=0; + for($i = 0; $i < $cxxlength; $i++){ + if(($cxxout[$i]>=16)&&($cxxout[$i]<=25)){ + # it's a number + if($digitcount == 0){ + $firstdigit=$i; + } + $digitcount++; + next; + } + if($digitcount >0){ + $j=pastedigits($digitcount,$j,$firstdigit,$lastset); + $digitcount=0; + } + $cxxoutout[$j] = $cxxout[$i]; + $j++; + if(($cxxout[$i]>=99)&&($cxxout[$i]<=101)){ + # it's a code switch + $lastset=$cxxout[$i]; + }else { + $lastset=0; + } + } + # $lastset is zero here, as there is no further need + # to switch the char set any more - we're at the end + $j=pastedigits($digitcount,$j,$firstdigit, 0); + return $j; +} + +################################################## +# code 128 is a little complicated +# if you have read till here, you already know. +# +sub codcxxviii{ + # locals + my ($i, $j, $sum); + my $srcstr=shift; + # first step: unhexing + $cxxlength = unhex($srcstr); + # @cxxchars now holds the characters the user wants + makectbl(); + # @ctbl now contains the possible tables for the chars in $j; + for($i =0; $i < $cxxlength;){ + $i += cxxchunk($i); + } + # change codeset switch to start + $cxxlength=$i; + $j=digitoptimize(); + # Start symbols are different from switch symbols + if($cxxoutout[0]==99){ + $cxxoutout[0]=105; + }elsif($cxxoutout[0]==100){ + $cxxoutout[0]=104; + }else{ + $cxxoutout[0]=103; + } + # calculate checksum and build output string + for($i=1,$sum=$cxxoutout[0];$i<$j;$i++){ + $sum+=$cxxoutout[$i]*$i; + } + $sum %=103; + $cxxoutout[$j]=$sum; + $j++; + $cxxoutout[$j]=106; #stop sign + $srcstr=""; + for($i=0;$i<($j+1);$i++){ + $srcstr .= sprintf "%02X", $cxxoutout[$i]; + } + $srcstr .= "@@"; + return $srcstr; +} + +################################################## +# do code 93 -- it's easy +################################################## +sub codxciii{ + my $srcstr=shift; + my $cstbl='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%()[]'; + my ($i, $j, $sumc, $sumh, $checkchar); + $sumc=$sumh=0; + for ($i=0;$i<length($srcstr);$i++){ + $j=index($cstbl, substr($srcstr,$i,1),0); + # $j is the check value of the character. + $sumh=$sumh+$j; + $sumc=$sumc+$sumh; + } + $srcstr=$srcstr . substr($cstbl,$sumc%47,1); + $sumc=$sumc+$sumh+($sumc%47); + $checkchar=substr($cstbl,$sumc%47,1); + $srcstr = $srcstr . $checkchar; + $srcstr =~ s/\$/\\\$/g; + $srcstr =~ s/%/\\%/g; + $srcstr =~ s/ /\\char\'040/g; + return $srcstr; +} + +################################################## +# we got both input and output file, +# we defined all subroutines, +# so here we go... +# +use vars qw ( $line $embedded $embtmp $mycod $eastring); + +open(EINGABE, $ifname) or die "No file"; +open(AUSGABE, $ofname) or die "Can't open output file"; +while($line=<EINGABE>){ + # save 0.0005 (est.) % running time + unless ($line =~ /^\\/){ + print AUSGABE $line; + next; + } + if($line =~ /^\\embed{(\d+)\}/){ + $embedded=$1; + print AUSGABE $line; + }elsif($line =~ /^\\eean\{(\d+)\}(.*)/){ + # embedded EAN + $embtmp=substr($embedded,0,12-length($1)); + $mycod=$embtmp . $1; + $eastring=eancod($mycod); + print AUSGABE "\\EAN{$eastring}$2 % embedded($1)\n"; + }elsif ($line =~ /^\\ean\{(\d+)\}(.*)/){ + # normal ean + $eastring=eancod($1); + print AUSGABE "\\EAN{$eastring}$2 %($1)\n"; + }elsif($line =~ /^\\isbn\{([\dxX]+)\}(.*)/){ + # isbn to be embedded + $embtmp=substr($1,0,9); + $mycod='978' . $embtmp; + $eastring=eancod($mycod); + print AUSGABE "\\EAN{$eastring}$2 % ISBN($1)\n"; + }elsif($line =~ /^\\cxxviii\{(.+)\}(.*)/){ + # code 128 + $eastring=codcxxviii($1); + print AUSGABE "\\CXXVIII $eastring $2 % Code128($1)\n"; + }elsif($line =~ /^\\xciii\{(.+)\}(.*)/){ + # code 93 + $eastring=codxciii($1); + print AUSGABE "\\XCIII{$eastring}$2 % Code93($1)\n"; + }else { + print AUSGABE $line; + } +} + +################################################## +# we're done, so we do some cleanup and quit. +close (EINGABE); +close (AUSGABE); +print "Done.\n"; + +################################################## +# what we do here is called +# 'falling off the edge of the world' +# in the camel book. +################################################## |