#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
 }

 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]
 }