Artifact Content
Not logged in

Artifact e3892410b86641a57a9f9238f726148d4e6ed415:


# Demo: DMC scanner using dmtx in AndroWish
# August 2015 <chw@ch-werner.de>

package require borg
package require tkpath
package require dmtx

. 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

# scale used for dmtx decoder
if {$width > 1280} {
    set img_scale 3
    set font {-family Courier -size -22 -weight normal}
} elseif {$width > 640} {
    set img_scale 2
    set font {-family Courier -size -18 -weight normal}
} else {
    set img_scale 1
    set font {-family Courier -size -16 -weight normal}
}

font create DMCFont {*}$font
set mwid [font measure DMCFont "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 DMCFont -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 {dmtx::async_decode cam_img dec_done $::img_scale} err]} {
	    old_img copy cam_img -compositingrule set
	}
    }
}

proc dec_done {flag time data} {
    if {$flag && ([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$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 {
	dmtx::async_decode abort
	borg camera stop
    }
}

proc do_pause {} {
    dmtx::async_decode stop
    borg camera stop
}

borg camera start