summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/source/fonts/barcode2/codean.pl
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2007-08-07 00:26:02 +0000
committerKarl Berry <karl@freefriends.org>2007-08-07 00:26:02 +0000
commit99fd92a6916e20374728792534ed7f201172aeba (patch)
tree2143eac2b9104766655bd6bbfcdced34dc82b978 /Master/texmf-dist/source/fonts/barcode2/codean.pl
parent19de762b4dff70b0b8ead478b4681b72d2f89853 (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.pl456
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.
-##################################################