'''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 <pascal@scheffers.net>
    # This code is placed in the public domain.
    
    package require Img
    package require Tk

    # ean13.tcl from http://wiki.tcl.tk/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 ""
    }

----

<<discussion>>
[SeS] (10th April, 2011): Hallo Pascal, I tried your script, but it failed, it returns:

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

I am not sure if this has to do with the tcl/tk version you used back in 2004 when you developed & shared the code with us, since I am using 8.4.19. Anyway I was able to fix the problem by adding the following right after the comment "#Now decode:" in proc scanline (of ean13.tcl):

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

replace_words_in_string is a procedure from [tG²], it simply uses 'string map' command to remove the dot inside the list which seems to cause the error. With the path, your script returned (using your example jpg):

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


<<categories>> Barcode