# Demo: barcode scanner using zbar in AndroWish # August 2015 package require borg package require tkpath package require zbar . configure -bg black wm attributes . -fullscreen 1 sdltk screensaver off sdltk touchtranslate 0 borg screenorientation landscape bind all exit bind all <> do_pause if {![borg camera open 0]} { label .nocam -text "Sorry, no camera found." -fg red -bg black -bd 0 pack .nocam -side top -fill both -expand 1 return } borg camera parameters preview-size 640x480 scan [dict get [borg camera parameters] preview-size] "%dx%d" width height if {$width > 1280} { set font {-family Courier -size -22 -weight normal} } elseif {$width > 640} { set font {-family Courier -size -18 -weight normal} } else { set font {-family Courier -size -16 -weight normal} } font create BarFont {*}$font set mwid [font measure BarFont "M"] set lbrk [expr round((1.0 * $width / $mwid) * 0.7)] tkp::canvas .c -width $width -height $height -bg black -bd 0 \ -highlightthickness 0 sdltk root $width $height pack .c -side top image create photo cam_img image create photo old_img cam_img configure -width 640 -height 480 .c create image 0 0 -anchor nw -image cam_img .c create text [expr {$width / 2}] [expr {$height / 3}] \ -fill #FFFFFF -tags data -anchor center -font BarFont -justify left bind .c <1> start_stop bind . <> {do_capture %x} proc do_capture {flag} { if {$flag} { borg camera greyimage cam_img if {![catch {zbar::async_decode cam_img dec_done} err]} { old_img copy cam_img -compositingrule set } } } proc dec_done {time type data} { if {($type ne "") && ([borg camera state] eq "capture")} { borg camera stop cam_img copy old_img -compositingrule set set pdata $data regsub -all {[[:cntrl:]]} $pdata " " pdata set prdata "" while {[string length $pdata]} { append prdata [string range $pdata 0 ${::lbrk}-1] "\n" set pdata [string range $pdata $::lbrk end] } append prdata "\n${type}, $time ms" .c itemconfigure data -text $prdata lassign [.c bbox data] x1 y1 x2 y2 set x1 [expr {$x1 - $::mwid}] set y1 [expr {$y1 - $::mwid}] set x2 [expr {$x2 + $::mwid}] set y2 [expr {$y2 + $::mwid}] .c create prect $x1 $y1 $x2 $y2 -fill #666666 -stroke #FFFFFF \ -fillopacity 0.7 -strokewidth 1 -tags databg .c lower databg data borg vibrate 100 borg beep } } proc start_stop {} { if {[borg camera state] ne "capture"} { borg camera start .c itemconfigure data -text "" .c delete databg } else { borg camera stop } } proc do_pause {} { zbar::async_decode stop borg camera stop } borg camera start