# Demo: barcode scanner using zbar in AndroWish
# August 2015 <chw@ch-werner.de>
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 <Key-Break> exit
bind all <<DidEnterBackground>> 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 . <<ImageCapture>> {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