diff options
Diffstat (limited to 'Master/texmf-dist/source/fonts/barcode2/codean.pl')
-rw-r--r-- | Master/texmf-dist/source/fonts/barcode2/codean.pl | 456 |
1 files changed, 456 insertions, 0 deletions
diff --git a/Master/texmf-dist/source/fonts/barcode2/codean.pl b/Master/texmf-dist/source/fonts/barcode2/codean.pl new file mode 100644 index 00000000000..6d398fae515 --- /dev/null +++ b/Master/texmf-dist/source/fonts/barcode2/codean.pl @@ -0,0 +1,456 @@ +# 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 +# +# 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 + +# 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); +} + +# make an ean + +sub eancod{ + 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 +# @ctbl holds the possible codings for these chars +# @cxxout holds the codes to be output for code 128 + +################################################## +# 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; +} + +################################################## +# 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){ + return $j; + } # else: we've found consecutive digits + elsif($digitcount<4){ + # but unfortunately not enough digits. + 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); + $firstdigit=0; + $digitcount=0; +zch: + for($i=0, $j=0; $i < $cxxlength; $i++){ + if(($cxxout[$i]>=16)&&($cxxout[$i]<=25)){ + # it's a number + if($digitcount == 0){ + $firstdigit=$i; + } + $digitcount++; + next zch; + } + $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]; + } + } + $j=pastedigits($digitcount,$j,$firstdigit, 0); + return $j; +} + +################################################## +# code 128 is a little complicated +# if you read till here, you already know. +# +sub codcxxviii{ + # locals + my ($i,$j,$sum); + my $srcstr=shift; + # reset all arrays + $cxxlength=0; + # 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(); + 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); + $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); + $srcstr=$srcstr . substr($cstbl,$sumc%47,1); + return $srcstr; +} + +################################################## +# we got both input and output file, +# we defined all subroutines, +# so here we go... +# +open(EINGABE, $ifname) or die "No file"; +open(AUSGABE, $ofname) or die "Can't open output file"; +while($line=<EINGABE>){ + 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. +################################################## |