## EAN-13 encode/decode functions

2004Dec17 PS

This code is used by Scan an EAN-13 barcode from an image, save it as ean13.tcl in the same directory.

``` #EAN 13 generation and decode routines
namespace eval ean13 {

#Digit bar/space widths
#Lefthand-even are pattern inverse of odd: zero: 3211 ==even==> 1123
set digits {
{3 2 1 1}.
{2 2 2 1}
{2 1 2 2}
{1 4 1 1}
{1 1 3 2}
{1 2 3 1}
{1 1 1 4}
{1 3 1 2}
{1 2 1 3}
{3 1 1 2}
}

set rdigits {
{1 1 2 3}
{1 2 2 2}
{2 2 1 2}
{1 1 4 1}
{2 3 1 1}
{1 3 2 1}
{4 1 1 1}
{2 1 3 1}
{3 1 2 1}
{2 1 1 3}
}

#parity encoding, the odd-even patterns of digits 2 through 7
set parity_table {
ooooo oeoee oeeoe oeeeo eooee
eeooe eeeoo eoeoe eoeeo eeoeo
}

proc lreverse { list } {
set l {}
for {set i [expr {[llength \$list]-1}]} {\$i> -1} {incr i -1} {
lappend l [lindex \$list \$i]
}
return \$l
}

proc scanline { line } {
variable digits
variable rdigits
variable parity_table
#Start scanning!
#Line is: {{pixel0 width0 isbar0} {pixel1 . .} ... }
set barcnt [llength \$line]

#try to locate a valid barcode (1=single bar, 0=single space):
# 101 (6*4 bars/spaces) 01010 (6*4 bars/spaces) 101
# there are 30 bars and 29 spaces in a barcode
# the width of the entire barcode has 95 element width units
for {set i 0} {\$i <\$barcnt-59} {incr i} {
#.t insert end "Offset \$i\n"

foreach {c isbar width} [lindex \$line \$i] {}
if { !\$isbar } { continue }

#Calculate X, the single item width.
foreach {c_end isbar width} [lindex \$line [expr {\$i+59}]] {}
set X [expr {(\$c_end-\$c)/95.0}]

#Now translate to integer values:
set widths {}
for { set j \$i } { \$j < \$i+59 } { incr j } {
foreach {c isbar width} [lindex \$line \$j] {}
lappend widths [expr { round( \$width/\$X ) } ]
}

#So, if this is valid EAN13, it should start with three ones:
if { [lrange \$widths 0 2] ne "1 1 1" } {
#.t insert end "Bad start guard\n"
continue
}
#It should also end with three ones:
if { [lrange \$widths end-2 end] ne "1 1 1" } {
#.t insert end "Bad end guard\n"
continue
}
#And the center pattern is five ones:
if { [lrange \$widths 27 31] ne "1 1 1 1 1" } {
#.t insert end "Bad center guard\n"
continue
}

#Got it. Try to decode.
#.t insert end "Found guards\n"

#Maybe reverse?
#Is the first digit left or righthand?
set d [lrange \$widths 3 6]

#.t insert end "First \$d >> [lsearch \$digits \$d] [lsearch \$rdigits \$d]\n"

if { [lsearch \$rdigits \$d] > -1 } {
#yes.
#.t insert end "Reverse! \n\$widths ..\n"

set widths [lreverse \$widths]
#.t insert end "\$widths ..\n"
}

#Now decode:
#First six digits:
set number {}

for {set j 0} {\$j<6} {incr j} {
set d [lrange \$widths [expr {3+\$j*4}] [expr {3+\$j*4+3}] ]
if { \$j == 0 } {
set n [lsearch \$digits \$d]
} else {
set n [lsearch \$digits \$d]
if { \$n > -1 } {
append parity o
} else {
set n [lsearch \$rdigits \$d]
append parity e
}
}
#.t insert end "Left digits: \$j == \$d >> \$n \n"
if { \$n == -1 } {
break
}

append number \$n
}
if { [string length \$number] < 4 } {
return ""
}

if { [string length \$number] < 6 } {
#decode error.
return "partial \$number"
}
set number [lsearch \$parity_table \$parity]\$number

#Last six digits:
for {set j 0} {\$j<6} {incr j} {
set d [lrange \$widths [expr {32+\$j*4}] [expr {32+\$j*4+3}] ]

set n [lsearch \$digits \$d]
#.t insert end "Right digits: \$j == \$d >> \$n \n"
if { \$n == -1 } {
break
}
append number \$n
}
#.t insert end "All digits \$number\n"
if { [string length \$number] == 13 } {
set c [ean13_csum [string range \$number 0 11]]
if { \$c ne [string index \$number 12] } {
return "partial/csum \$number"
}
return \$number
}
return "partial \$number"

}
}

proc ean13 { number } {
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}
}

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 { [string length \$number] == 12 } {
set number \$number[ean13_csum \$number]
}

#left guard bars:
lappend bars 101
#second system char:
lappend bars [lindex [lindex \$digits [string index \$number 1]] 1]

#the five digits that encode the first 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:
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]
}

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
}

}```

 Category Barcode