diff options
author | Karl Berry <karl@freefriends.org> | 2007-08-07 00:26:02 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2007-08-07 00:26:02 +0000 |
commit | 99fd92a6916e20374728792534ed7f201172aeba (patch) | |
tree | 2143eac2b9104766655bd6bbfcdced34dc82b978 /Master/texmf-dist/source/fonts/barcode2/codean.pl | |
parent | 19de762b4dff70b0b8ead478b4681b72d2f89853 (diff) |
rm barcode2, it is now in barcodes a la ctan
git-svn-id: svn://tug.org/texlive/trunk@4707 c570f23f-e606-0410-a88d-b1316a301751
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, 0 insertions, 456 deletions
diff --git a/Master/texmf-dist/source/fonts/barcode2/codean.pl b/Master/texmf-dist/source/fonts/barcode2/codean.pl deleted file mode 100644 index 6d398fae515..00000000000 --- a/Master/texmf-dist/source/fonts/barcode2/codean.pl +++ /dev/null @@ -1,456 +0,0 @@ -# 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. -################################################## |