Scan an EAN-13 barcode from an image

2004Dec17 PS

This code will try to scan EAN-13 barcodes from jpeg images in the current working directory. You must include the EAN-13 encode/decode functions in the same directory as this small application.

It will scan the barcodes from images like http://pascal.scheffers.net/images/barcode-sample1.jpg (not inlined due to size).

The detection is sloooooow. And it will only work with rather clean images, sorry.

    #Copyright (C) 2003 Pascal Scheffers <[email protected]>
    # This code is placed in the public domain.

    package require Img
    package require Tk

    # ean13.tcl from https://wiki.tcl-lang.org/13192
    source ean13.tcl

    proc getline { img line angle } {
        set pixels {}
        set w [image width $img]
        for {set i 1} {$i < $w} { incr i } {
            lappend pixels [lindex [$img get $i $line] 0]
        }
        return $pixels
    }

    proc blackwhite { pixel } {
        return [lindex $pixel 0]
        foreach {r g b} $pixel {}
        #return [expr {$r < 150 } ]
        return [expr { ($r+$g+$b)/3 }]    
    }

    proc average { list } {
        set val [lindex $list 0]
        foreach item [lrange $list 1 end] {
            set val [expr {$val+$item/2}]
        }
        return $val
    }



    proc scanline { line {threshold 125} } {    
        set isbar 0
        set prev 0
        set width 0
        set c 0
        set quietzone {}
        append threshold ".0"

        foreach pix $line {        
            incr c

            #build the quietzone:

            #and the average 'signal'

            #edge?
            set e 999
            if { $prev != $pix && (($prev < $threshold && $pix >= $threshold) || \
                ($pix < $threshold && $prev >= $threshold)) } {
                if { $prev > $pix } {
                    set e [expr { 1- ($threshold-$pix)/($prev-$pix) }]
                } else {
                    set e [expr { ($threshold-$prev)/($pix-$prev) }]
                }
            }

            #.t insert end "$c $prev > $pix = [expr $prev>$pix] :: e=$e \n"
            #.t insert end "$c\t$prev\n"
            if { $e > 0 && $e <= 1 } {            
                #edge!
                set width [expr {$width+abs($e)}]
                lappend lengths [list $c $isbar $width] 
                #.t insert end "Edge -- Isbar: $isbar width: $width\n"
                set width [expr {1-abs($e)}]
                set isbar [expr {$prev > $pix} ]
            } else {
                set width [expr {$width+1}]
            }

            set prev $pix

        }

        lappend lengths [list $c $isbar $width]
        return $lengths

    }






    image create photo
    button .b -text "Do it" -command do_it
    button .bt -text "time it" -command timing
    grid .b .bt
    text .t -width 60 -height 40 
    grid .t -

    proc do_it {} {
        foreach file [glob *.jpg] {
            .t insert end "File $file...\n"
            update
            set img [image create photo -file $file]
            # 9789069 744063

            #Threshold pattern:
            set height [image height $img]        
            set line_interval [expr {$height  / 220}]
            foreach j {125 122 128 118 132 112 137 105 145 95 155} {
                puts $j

                for {set i 0} {$i < $height/2} {incr i $line_interval} {
                    set line [expr {$height/2 + $i}] 
                    set pixs [getline $img $i 0]
                    set lens [scanline $pixs $j]                
                    set nbr [ean13::scanline $lens]
                    if {[string match "partial*" $nbr]} {
                        set nbr [finescan $img $i $line_interval $j]
                        #finescan only ever returns a number or ""
                    } 
                    if {$nbr ne ""} {                    
                        break
                    }

                    if { $i != 0 } {
                        set line [expr {$height/2 - $i}] 
                        set pixs [getline $img $i 0]
                        set lens [scanline $pixs $j]                
                        set nbr [ean13::scanline $lens]
                        if {[string match "partial*" $nbr]} {
                            set nbr [finescan $img $i $line_interval $j]
                            #finescan only ever returns a number or ""
                        } 
                        if {$nbr ne ""} {                    
                            break
                        }
                        update
                    }
                }
                if {$nbr ne ""} {                    
                    break
                }


            }
            .t insert end "\tScan $file $i, $j: $nbr\n"    
            update
            set nbr ""
        }
        .t insert end "\tDone.\n"
    }

    proc finescan {img start width threshold} {
        #scans all lines near a partial read.
        set height [image height $img]
        set nbr ""

        for {set t -2} {$t <3} {incr t} {
            set thr [expr {$threshold +$t}]
            for {set i [expr {$start-$width}]} {$i < $start+$width} {incr i} {
                if { $i > 0 && $i < $height } {
                    set pixs [getline $img $i 0]
                    set lens [scanline $pixs $thr]                
                    set nbr [ean13::scanline $lens]

                    if {[string match "partial*" $nbr]} {
                        .t insert end "Fine line $i/$thr: $nbr\n"
                        set nbr ""
                    } 
                    if {$nbr ne ""} {                    
                        return $nbr
                    }
                }
            }

        }
        return $nbr


    }

    proc timing {} {
        set file [lindex [glob scan/*.jpg] 0] 

        .t insert end "File $file...\n"
        update
        set img [image create photo -file $file]
        # 9789069 744063

        foreach j {125 122 128 118 132 112 137 105 145 95 155} {
            puts $j
            for {set i -100} {$i < 100} {incr i 5} {
                set line [expr [image height $img]/2+$i ]
                .t insert end "Getline [time {
                    set pixs [getline $img $line 0]
                }]\n"

                .t insert end "Scanline [time {
                set lens [scanline $pixs $j]
                }]\n"

                .t insert end "eanscanline [time {

                set nbr [ean13::scanline $lens]
                }]\n"

                if {$nbr ne ""} {
                    break
                }
            }

            if {$nbr ne ""} {
                break
            }
        }

        .t insert end "Scan $file $i, $j: $nbr\n"    
        update
        set nbr ""
    }

    list element in braces followed by "." instead of space
    while executing
    "lsearch $digits $d"
    (procedure "ean13::scanline" line 73)

    set digits [replace_words_in_string "." $digits ""]

    File barcode-sample1.jpg...
        Scan barcode-sample1.jpg 158, 125: 9789069744063

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