if { 0 } {
[PS] 10Dec2003 - Making EAN13 barcodes is slightly more complex than [Code 39 generation], but not a very difficult task. 

I got almost all information on how to do this from [http://www.barcodeisland.com/ean13.phtml]. If you're interested in this app, you should really go read that page and related ones. 

I have included a sample (real) product number: 8710400163398 decodes as:

 87 - netherlands
 10400 - Albert Heijn
 16339 - Fruit drink orange-peach
 8 - check digit

[http://pascal.scheffers.net/software/barcode-screenshot.gif]

Have fun -- Pascal.

----
}
 if { 1 } {
    #EAN 13 encoding routines.
    #A complete description of EAN-13 barcodes can be found on 
    # http://www.barcodeisland.com/ean13.phtml
    
    #The EAN13 check sum is calculated by taking the first twelve
    #digits of the barcode (the 13th will be the check digit)
    #Take all odd number digits (the first digit is odd) add them up 
    #and multiply by 3. Add to that the sum of the remaining six even positions
    #The checkdigit is an inverted modulo 10. Eaxample: If the total sum is 87
    #how much must I add to get to the next multiple of ten (90) which is 
    #three. Making the check digit '3'.

    proc ean13_csum { number } {
	set odd 1
	set sum 0
	foreach digit [split $number ""] {
	    set odd [expr {!$odd}]
	    puts "$sum += ($odd*2+1)*$digit :: [expr {($odd*2+1)*$digit}]"
	    incr sum [expr {($odd*2+1)*$digit}]
	}
	set check [expr {$sum % 10}]
	if { $check > 0 } {
	    return [expr {10 - $check}]
	}
	return $check
    }

    proc ean13 { number } {

	if { [string length $number] < 12 } {
	    error "Not enough digits, need 12 or 13."
	}

	#EAN13 digits, the ones represent black bars, the zeroes white space.
	#Three pairs of digits: lefthand-odd(A), lefthand-even(B) and righthand
	
	set digits {
	    {0 0001101 0100111 1110010}
	    {1 0011001 0110011 1100110}
	    {2 0010011 0011011 1101100}
	    {3 0111101 0100001 1000010}
	    {4 0100011 0011101 1011100} 
	    {5 0110001 0111001 1001110}
	    {6 0101111 0000101 1010000}
	    {7 0111011 0010001 1000100}
	    {8 0110111 0001001 1001000}
	    {9 0001011 0010111 1110100}
	}

	#The first digit of the ean13 code is encoded in the parity of 
	#characters 2 through 7, using this table. Note that the ones and twos
	#are just list indices to the digits table above.
	array set parity_enc {
	    0 {1 1 1 1 1}
	    1 {1 2 1 2 2}
	    2 {1 2 2 1 2}
	    3 {1 2 2 2 1}
	    4 {2 1 1 2 2}
	    5 {2 2 1 1 2}
	    6 {2 2 2 1 1}
	    7 {2 1 2 1 2}
	    8 {2 1 2 2 1}
	    9 {2 2 1 2 1}
	}
	
	#If we get a twelve digit number, append the checkdigit to that:
	if { [string length $number] == 12 } {
	    set number $number[ean13_csum $number]
	}
	
	#All EAN13 codes start with 'left guard bars':
	lappend bars 101
	#second 'system' char, encoded as a lefthand-odd character:
	lappend bars [lindex [lindex $digits [string index $number 1]] 1]    

	#the five digits that encode the first 'system' digit in their parity:
	foreach digit [split [string range $number 2 6] ""] \
	    enc $parity_enc([string index $number 0]) {
		lappend bars [lindex [lindex $digits $digit] $enc]
	    }

	#center guard bars:
	lappend bars 01010

	#the right hand chars, all encoded the same:
	for {set i 7} {$i<13} {incr i} {
	    lappend bars [lindex [lindex $digits [string index $number $i]] 3]
	}

	#and the final guards:
	lappend bars 101
	
	return [list $bars $number]
    }

    # Tk demo code:

    package require Tk

    wm title . "EAN-13 Barcode"

    label .lbar -text "Barcode"
    entry .barcode -textvariable barcode -width 15
    button .show -text show -command do_display
    grid .lbar .barcode .show -sticky nw

    canvas .c -width 200 -height 100

    grid x .c - -sticky nw

    proc do_display { } {
	global barcode 
	if { [string length $barcode] < 12 } {
	    return
	}
	
	.c delete all
	set b [ean13 $barcode]

	set x 25 
	foreach barset [lindex $b 0] {

	    set bars [split $barset ""]

	    if {[llength $bars] == 7} {
		set len 40
	    } else {
		set len 46
	    }

	   foreach bar $bars { 
		incr x 1
		if { $bar } {
		    .c create line $x 15 $x [expr $len+15]   

		}
	    }
	}

	#And create the human readable text below it:
	.c create text 21 60 -text [string index [lindex $b 1] 0]
	.c create text 49 60 -text [string range [lindex $b 1] 1 6]
	.c create text 95 60 -text [string range [lindex $b 1] 7 12]
	
    }

    set barcode {8710400163398} 

    do_display
 }

----
[kroc] 11 Oct 2004 : If you want to do EAN8 barcodes too, you should replace [[ean13_csum]] by this one:
 proc ean13_csum { number } {
    set C 0
    if {[string length $number]%2 != 0} {
        set number 0$number
    }
    foreach { I P } [split $number {}] {
        set C [expr $C + (3 * $P) + $I]
    }
    return [string index [expr 10-$C%10] end]
 }