Artifact
4ce598aa1fc82dc9a41a04992a94673cb4d863af
File
assets/zbar0.10/android_demo.tcl
— part of check-in
[65543ac01b]
at
2015-08-15 17:35:12
on branch trunk
— added ZBar module with tcl binding similar to dmtx
(user:
chw
size: 2688)
0000: 23 20 44 65 6d 6f 3a 20 62 61 72 63 6f 64 65 20 # Demo: barcode
0010: 73 63 61 6e 6e 65 72 20 75 73 69 6e 67 20 7a 62 scanner using zb
0020: 61 72 20 69 6e 20 41 6e 64 72 6f 57 69 73 68 0a ar in AndroWish.
0030: 23 20 41 75 67 75 73 74 20 32 30 31 35 20 3c 63 # August 2015 <c
0040: 68 77 40 63 68 2d 77 65 72 6e 65 72 2e 64 65 3e hw@ch-werner.de>
0050: 0a 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
0060: 65 20 62 6f 72 67 0a 70 61 63 6b 61 67 65 20 72 e borg.package r
0070: 65 71 75 69 72 65 20 74 6b 70 61 74 68 0a 70 61 equire tkpath.pa
0080: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 7a 62 ckage require zb
0090: 61 72 0a 0a 2e 20 63 6f 6e 66 69 67 75 72 65 20 ar... configure
00a0: 2d 62 67 20 62 6c 61 63 6b 0a 77 6d 20 61 74 74 -bg black.wm att
00b0: 72 69 62 75 74 65 73 20 2e 20 2d 66 75 6c 6c 73 ributes . -fulls
00c0: 63 72 65 65 6e 20 31 0a 73 64 6c 74 6b 20 73 63 creen 1.sdltk sc
00d0: 72 65 65 6e 73 61 76 65 72 20 6f 66 66 0a 73 64 reensaver off.sd
00e0: 6c 74 6b 20 74 6f 75 63 68 74 72 61 6e 73 6c 61 ltk touchtransla
00f0: 74 65 20 30 0a 62 6f 72 67 20 73 63 72 65 65 6e te 0.borg screen
0100: 6f 72 69 65 6e 74 61 74 69 6f 6e 20 6c 61 6e 64 orientation land
0110: 73 63 61 70 65 0a 62 69 6e 64 20 61 6c 6c 20 3c scape.bind all <
0120: 4b 65 79 2d 42 72 65 61 6b 3e 20 65 78 69 74 0a Key-Break> exit.
0130: 62 69 6e 64 20 61 6c 6c 20 3c 3c 44 69 64 45 6e bind all <<DidEn
0140: 74 65 72 42 61 63 6b 67 72 6f 75 6e 64 3e 3e 20 terBackground>>
0150: 64 6f 5f 70 61 75 73 65 0a 0a 69 66 20 7b 21 5b do_pause..if {![
0160: 62 6f 72 67 20 63 61 6d 65 72 61 20 6f 70 65 6e borg camera open
0170: 20 30 5d 7d 20 7b 0a 20 20 20 20 6c 61 62 65 6c 0]} {. label
0180: 20 2e 6e 6f 63 61 6d 20 2d 74 65 78 74 20 22 53 .nocam -text "S
0190: 6f 72 72 79 2c 20 6e 6f 20 63 61 6d 65 72 61 20 orry, no camera
01a0: 66 6f 75 6e 64 2e 22 20 2d 66 67 20 72 65 64 20 found." -fg red
01b0: 2d 62 67 20 62 6c 61 63 6b 20 2d 62 64 20 30 0a -bg black -bd 0.
01c0: 20 20 20 20 70 61 63 6b 20 2e 6e 6f 63 61 6d 20 pack .nocam
01d0: 2d 73 69 64 65 20 74 6f 70 20 2d 66 69 6c 6c 20 -side top -fill
01e0: 62 6f 74 68 20 2d 65 78 70 61 6e 64 20 31 0a 20 both -expand 1.
01f0: 20 20 20 72 65 74 75 72 6e 0a 7d 0a 0a 62 6f 72 return.}..bor
0200: 67 20 63 61 6d 65 72 61 20 70 61 72 61 6d 65 74 g camera paramet
0210: 65 72 73 20 70 72 65 76 69 65 77 2d 73 69 7a 65 ers preview-size
0220: 20 36 34 30 78 34 38 30 0a 73 63 61 6e 20 5b 64 640x480.scan [d
0230: 69 63 74 20 67 65 74 20 5b 62 6f 72 67 20 63 61 ict get [borg ca
0240: 6d 65 72 61 20 70 61 72 61 6d 65 74 65 72 73 5d mera parameters]
0250: 20 70 72 65 76 69 65 77 2d 73 69 7a 65 5d 20 22 preview-size] "
0260: 25 64 78 25 64 22 20 77 69 64 74 68 20 68 65 69 %dx%d" width hei
0270: 67 68 74 0a 0a 69 66 20 7b 24 77 69 64 74 68 20 ght..if {$width
0280: 3e 20 31 32 38 30 7d 20 7b 0a 20 20 20 20 73 65 > 1280} {. se
0290: 74 20 66 6f 6e 74 20 7b 2d 66 61 6d 69 6c 79 20 t font {-family
02a0: 43 6f 75 72 69 65 72 20 2d 73 69 7a 65 20 2d 32 Courier -size -2
02b0: 32 20 2d 77 65 69 67 68 74 20 6e 6f 72 6d 61 6c 2 -weight normal
02c0: 7d 0a 7d 20 65 6c 73 65 69 66 20 7b 24 77 69 64 }.} elseif {$wid
02d0: 74 68 20 3e 20 36 34 30 7d 20 7b 0a 20 20 20 20 th > 640} {.
02e0: 73 65 74 20 66 6f 6e 74 20 7b 2d 66 61 6d 69 6c set font {-famil
02f0: 79 20 43 6f 75 72 69 65 72 20 2d 73 69 7a 65 20 y Courier -size
0300: 2d 31 38 20 2d 77 65 69 67 68 74 20 6e 6f 72 6d -18 -weight norm
0310: 61 6c 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 al}.} else {.
0320: 20 73 65 74 20 66 6f 6e 74 20 7b 2d 66 61 6d 69 set font {-fami
0330: 6c 79 20 43 6f 75 72 69 65 72 20 2d 73 69 7a 65 ly Courier -size
0340: 20 2d 31 36 20 2d 77 65 69 67 68 74 20 6e 6f 72 -16 -weight nor
0350: 6d 61 6c 7d 0a 7d 0a 0a 66 6f 6e 74 20 63 72 65 mal}.}..font cre
0360: 61 74 65 20 42 61 72 46 6f 6e 74 20 7b 2a 7d 24 ate BarFont {*}$
0370: 66 6f 6e 74 0a 73 65 74 20 6d 77 69 64 20 5b 66 font.set mwid [f
0380: 6f 6e 74 20 6d 65 61 73 75 72 65 20 42 61 72 46 ont measure BarF
0390: 6f 6e 74 20 22 4d 22 5d 0a 73 65 74 20 6c 62 72 ont "M"].set lbr
03a0: 6b 20 5b 65 78 70 72 20 72 6f 75 6e 64 28 28 31 k [expr round((1
03b0: 2e 30 20 2a 20 24 77 69 64 74 68 20 2f 20 24 6d .0 * $width / $m
03c0: 77 69 64 29 20 2a 20 30 2e 37 29 5d 0a 0a 74 6b wid) * 0.7)]..tk
03d0: 70 3a 3a 63 61 6e 76 61 73 20 2e 63 20 2d 77 69 p::canvas .c -wi
03e0: 64 74 68 20 24 77 69 64 74 68 20 2d 68 65 69 67 dth $width -heig
03f0: 68 74 20 24 68 65 69 67 68 74 20 2d 62 67 20 62 ht $height -bg b
0400: 6c 61 63 6b 20 2d 62 64 20 30 20 5c 0a 20 20 20 lack -bd 0 \.
0410: 20 2d 68 69 67 68 6c 69 67 68 74 74 68 69 63 6b -highlightthick
0420: 6e 65 73 73 20 30 0a 0a 73 64 6c 74 6b 20 72 6f ness 0..sdltk ro
0430: 6f 74 20 24 77 69 64 74 68 20 24 68 65 69 67 68 ot $width $heigh
0440: 74 0a 0a 70 61 63 6b 20 2e 63 20 2d 73 69 64 65 t..pack .c -side
0450: 20 74 6f 70 0a 0a 69 6d 61 67 65 20 63 72 65 61 top..image crea
0460: 74 65 20 70 68 6f 74 6f 20 63 61 6d 5f 69 6d 67 te photo cam_img
0470: 0a 69 6d 61 67 65 20 63 72 65 61 74 65 20 70 68 .image create ph
0480: 6f 74 6f 20 6f 6c 64 5f 69 6d 67 0a 63 61 6d 5f oto old_img.cam_
0490: 69 6d 67 20 63 6f 6e 66 69 67 75 72 65 20 2d 77 img configure -w
04a0: 69 64 74 68 20 36 34 30 20 2d 68 65 69 67 68 74 idth 640 -height
04b0: 20 34 38 30 0a 2e 63 20 63 72 65 61 74 65 20 69 480..c create i
04c0: 6d 61 67 65 20 30 20 30 20 2d 61 6e 63 68 6f 72 mage 0 0 -anchor
04d0: 20 6e 77 20 2d 69 6d 61 67 65 20 63 61 6d 5f 69 nw -image cam_i
04e0: 6d 67 0a 2e 63 20 63 72 65 61 74 65 20 74 65 78 mg..c create tex
04f0: 74 20 5b 65 78 70 72 20 7b 24 77 69 64 74 68 20 t [expr {$width
0500: 2f 20 32 7d 5d 20 5b 65 78 70 72 20 7b 24 68 65 / 2}] [expr {$he
0510: 69 67 68 74 20 2f 20 33 7d 5d 20 5c 0a 20 20 20 ight / 3}] \.
0520: 20 2d 66 69 6c 6c 20 23 46 46 46 46 46 46 20 2d -fill #FFFFFF -
0530: 74 61 67 73 20 64 61 74 61 20 2d 61 6e 63 68 6f tags data -ancho
0540: 72 20 63 65 6e 74 65 72 20 2d 66 6f 6e 74 20 42 r center -font B
0550: 61 72 46 6f 6e 74 20 2d 6a 75 73 74 69 66 79 20 arFont -justify
0560: 6c 65 66 74 0a 0a 62 69 6e 64 20 2e 63 20 3c 31 left..bind .c <1
0570: 3e 20 73 74 61 72 74 5f 73 74 6f 70 0a 62 69 6e > start_stop.bin
0580: 64 20 2e 20 3c 3c 49 6d 61 67 65 43 61 70 74 75 d . <<ImageCaptu
0590: 72 65 3e 3e 20 7b 64 6f 5f 63 61 70 74 75 72 65 re>> {do_capture
05a0: 20 25 78 7d 0a 0a 70 72 6f 63 20 64 6f 5f 63 61 %x}..proc do_ca
05b0: 70 74 75 72 65 20 7b 66 6c 61 67 7d 20 7b 0a 20 pture {flag} {.
05c0: 20 20 20 69 66 20 7b 24 66 6c 61 67 7d 20 7b 0a if {$flag} {.
05d0: 09 62 6f 72 67 20 63 61 6d 65 72 61 20 67 72 65 .borg camera gre
05e0: 79 69 6d 61 67 65 20 63 61 6d 5f 69 6d 67 0a 09 yimage cam_img..
05f0: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 7a 62 61 if {![catch {zba
0600: 72 3a 3a 61 73 79 6e 63 5f 64 65 63 6f 64 65 20 r::async_decode
0610: 63 61 6d 5f 69 6d 67 20 64 65 63 5f 64 6f 6e 65 cam_img dec_done
0620: 7d 20 65 72 72 5d 7d 20 7b 0a 09 20 20 20 20 6f } err]} {.. o
0630: 6c 64 5f 69 6d 67 20 63 6f 70 79 20 63 61 6d 5f ld_img copy cam_
0640: 69 6d 67 20 2d 63 6f 6d 70 6f 73 69 74 69 6e 67 img -compositing
0650: 72 75 6c 65 20 73 65 74 0a 09 7d 0a 20 20 20 20 rule set..}.
0660: 7d 0a 7d 0a 0a 70 72 6f 63 20 64 65 63 5f 64 6f }.}..proc dec_do
0670: 6e 65 20 7b 74 69 6d 65 20 74 79 70 65 20 64 61 ne {time type da
0680: 74 61 7d 20 7b 0a 20 20 20 20 69 66 20 7b 28 24 ta} {. if {($
0690: 74 79 70 65 20 6e 65 20 22 22 29 20 26 26 20 28 type ne "") && (
06a0: 5b 62 6f 72 67 20 63 61 6d 65 72 61 20 73 74 61 [borg camera sta
06b0: 74 65 5d 20 65 71 20 22 63 61 70 74 75 72 65 22 te] eq "capture"
06c0: 29 7d 20 7b 0a 09 62 6f 72 67 20 63 61 6d 65 72 )} {..borg camer
06d0: 61 20 73 74 6f 70 0a 09 63 61 6d 5f 69 6d 67 20 a stop..cam_img
06e0: 63 6f 70 79 20 6f 6c 64 5f 69 6d 67 20 2d 63 6f copy old_img -co
06f0: 6d 70 6f 73 69 74 69 6e 67 72 75 6c 65 20 73 65 mpositingrule se
0700: 74 0a 09 73 65 74 20 70 64 61 74 61 20 24 64 61 t..set pdata $da
0710: 74 61 0a 09 72 65 67 73 75 62 20 2d 61 6c 6c 20 ta..regsub -all
0720: 7b 5b 5b 3a 63 6e 74 72 6c 3a 5d 5d 7d 20 24 70 {[[:cntrl:]]} $p
0730: 64 61 74 61 20 22 20 22 20 70 64 61 74 61 0a 09 data " " pdata..
0740: 73 65 74 20 70 72 64 61 74 61 20 22 22 0a 09 77 set prdata ""..w
0750: 68 69 6c 65 20 7b 5b 73 74 72 69 6e 67 20 6c 65 hile {[string le
0760: 6e 67 74 68 20 24 70 64 61 74 61 5d 7d 20 7b 0a ngth $pdata]} {.
0770: 09 20 20 20 20 61 70 70 65 6e 64 20 70 72 64 61 . append prda
0780: 74 61 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 ta [string range
0790: 20 24 70 64 61 74 61 20 30 20 24 7b 3a 3a 6c 62 $pdata 0 ${::lb
07a0: 72 6b 7d 2d 31 5d 20 22 5c 6e 22 0a 09 20 20 20 rk}-1] "\n"..
07b0: 20 73 65 74 20 70 64 61 74 61 20 5b 73 74 72 69 set pdata [stri
07c0: 6e 67 20 72 61 6e 67 65 20 24 70 64 61 74 61 20 ng range $pdata
07d0: 24 3a 3a 6c 62 72 6b 20 65 6e 64 5d 0a 09 7d 0a $::lbrk end]..}.
07e0: 09 61 70 70 65 6e 64 20 70 72 64 61 74 61 20 22 .append prdata "
07f0: 5c 6e 24 7b 74 79 70 65 7d 2c 20 24 74 69 6d 65 \n${type}, $time
0800: 20 6d 73 22 0a 09 2e 63 20 69 74 65 6d 63 6f 6e ms"...c itemcon
0810: 66 69 67 75 72 65 20 64 61 74 61 20 2d 74 65 78 figure data -tex
0820: 74 20 24 70 72 64 61 74 61 0a 09 6c 61 73 73 69 t $prdata..lassi
0830: 67 6e 20 5b 2e 63 20 62 62 6f 78 20 64 61 74 61 gn [.c bbox data
0840: 5d 20 78 31 20 79 31 20 78 32 20 79 32 0a 09 73 ] x1 y1 x2 y2..s
0850: 65 74 20 78 31 20 5b 65 78 70 72 20 7b 24 78 31 et x1 [expr {$x1
0860: 20 2d 20 24 3a 3a 6d 77 69 64 7d 5d 0a 09 73 65 - $::mwid}]..se
0870: 74 20 79 31 20 5b 65 78 70 72 20 7b 24 79 31 20 t y1 [expr {$y1
0880: 2d 20 24 3a 3a 6d 77 69 64 7d 5d 0a 09 73 65 74 - $::mwid}]..set
0890: 20 78 32 20 5b 65 78 70 72 20 7b 24 78 32 20 2b x2 [expr {$x2 +
08a0: 20 24 3a 3a 6d 77 69 64 7d 5d 0a 09 73 65 74 20 $::mwid}]..set
08b0: 79 32 20 5b 65 78 70 72 20 7b 24 79 32 20 2b 20 y2 [expr {$y2 +
08c0: 24 3a 3a 6d 77 69 64 7d 5d 0a 09 2e 63 20 63 72 $::mwid}]...c cr
08d0: 65 61 74 65 20 70 72 65 63 74 20 24 78 31 20 24 eate prect $x1 $
08e0: 79 31 20 24 78 32 20 24 79 32 20 2d 66 69 6c 6c y1 $x2 $y2 -fill
08f0: 20 23 36 36 36 36 36 36 20 2d 73 74 72 6f 6b 65 #666666 -stroke
0900: 20 23 46 46 46 46 46 46 20 5c 0a 09 20 20 20 20 #FFFFFF \..
0910: 2d 66 69 6c 6c 6f 70 61 63 69 74 79 20 30 2e 37 -fillopacity 0.7
0920: 20 2d 73 74 72 6f 6b 65 77 69 64 74 68 20 31 20 -strokewidth 1
0930: 2d 74 61 67 73 20 64 61 74 61 62 67 0a 09 2e 63 -tags databg...c
0940: 20 6c 6f 77 65 72 20 64 61 74 61 62 67 20 64 61 lower databg da
0950: 74 61 0a 09 62 6f 72 67 20 76 69 62 72 61 74 65 ta..borg vibrate
0960: 20 31 30 30 0a 09 62 6f 72 67 20 62 65 65 70 0a 100..borg beep.
0970: 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 73 74 }.}..proc st
0980: 61 72 74 5f 73 74 6f 70 20 7b 7d 20 7b 0a 20 20 art_stop {} {.
0990: 20 20 69 66 20 7b 5b 62 6f 72 67 20 63 61 6d 65 if {[borg came
09a0: 72 61 20 73 74 61 74 65 5d 20 6e 65 20 22 63 61 ra state] ne "ca
09b0: 70 74 75 72 65 22 7d 20 7b 0a 09 62 6f 72 67 20 pture"} {..borg
09c0: 63 61 6d 65 72 61 20 73 74 61 72 74 0a 09 2e 63 camera start...c
09d0: 20 69 74 65 6d 63 6f 6e 66 69 67 75 72 65 20 64 itemconfigure d
09e0: 61 74 61 20 2d 74 65 78 74 20 22 22 0a 09 2e 63 ata -text ""...c
09f0: 20 64 65 6c 65 74 65 20 64 61 74 61 62 67 0a 20 delete databg.
0a00: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 62 6f 72 } else {..bor
0a10: 67 20 63 61 6d 65 72 61 20 73 74 6f 70 0a 20 20 g camera stop.
0a20: 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 64 6f 5f 70 }.}..proc do_p
0a30: 61 75 73 65 20 7b 7d 20 7b 0a 20 20 20 20 7a 62 ause {} {. zb
0a40: 61 72 3a 3a 61 73 79 6e 63 5f 64 65 63 6f 64 65 ar::async_decode
0a50: 20 73 74 6f 70 0a 20 20 20 20 62 6f 72 67 20 63 stop. borg c
0a60: 61 6d 65 72 61 20 73 74 6f 70 0a 7d 0a 0a 62 6f amera stop.}..bo
0a70: 72 67 20 63 61 6d 65 72 61 20 73 74 61 72 74 0a rg camera start.