Artifact
e3892410b86641a57a9f9238f726148d4e6ed415
File
assets/dmtx0.7.5/android_demo.tcl
— part of check-in
[a9f0db9325]
at
2015-08-15 10:42:07
on branch trunk
— small improvements in dmtx module plus other changes
(user:
chw
size: 2796)
0000: 23 20 44 65 6d 6f 3a 20 44 4d 43 20 73 63 61 6e # Demo: DMC scan
0010: 6e 65 72 20 75 73 69 6e 67 20 64 6d 74 78 20 69 ner using dmtx i
0020: 6e 20 41 6e 64 72 6f 57 69 73 68 0a 23 20 41 75 n AndroWish.# Au
0030: 67 75 73 74 20 32 30 31 35 20 3c 63 68 77 40 63 gust 2015 <chw@c
0040: 68 2d 77 65 72 6e 65 72 2e 64 65 3e 0a 0a 70 61 h-werner.de>..pa
0050: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 62 6f ckage require bo
0060: 72 67 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 rg.package requi
0070: 72 65 20 74 6b 70 61 74 68 0a 70 61 63 6b 61 67 re tkpath.packag
0080: 65 20 72 65 71 75 69 72 65 20 64 6d 74 78 0a 0a e require dmtx..
0090: 2e 20 63 6f 6e 66 69 67 75 72 65 20 2d 62 67 20 . configure -bg
00a0: 62 6c 61 63 6b 0a 77 6d 20 61 74 74 72 69 62 75 black.wm attribu
00b0: 74 65 73 20 2e 20 2d 66 75 6c 6c 73 63 72 65 65 tes . -fullscree
00c0: 6e 20 31 0a 73 64 6c 74 6b 20 73 63 72 65 65 6e n 1.sdltk screen
00d0: 73 61 76 65 72 20 6f 66 66 0a 73 64 6c 74 6b 20 saver off.sdltk
00e0: 74 6f 75 63 68 74 72 61 6e 73 6c 61 74 65 20 30 touchtranslate 0
00f0: 0a 62 6f 72 67 20 73 63 72 65 65 6e 6f 72 69 65 .borg screenorie
0100: 6e 74 61 74 69 6f 6e 20 6c 61 6e 64 73 63 61 70 ntation landscap
0110: 65 0a 62 69 6e 64 20 61 6c 6c 20 3c 4b 65 79 2d e.bind all <Key-
0120: 42 72 65 61 6b 3e 20 65 78 69 74 0a 62 69 6e 64 Break> exit.bind
0130: 20 61 6c 6c 20 3c 3c 44 69 64 45 6e 74 65 72 42 all <<DidEnterB
0140: 61 63 6b 67 72 6f 75 6e 64 3e 3e 20 64 6f 5f 70 ackground>> do_p
0150: 61 75 73 65 0a 0a 69 66 20 7b 21 5b 62 6f 72 67 ause..if {![borg
0160: 20 63 61 6d 65 72 61 20 6f 70 65 6e 20 30 5d 7d camera open 0]}
0170: 20 7b 0a 20 20 20 20 6c 61 62 65 6c 20 2e 6e 6f {. label .no
0180: 63 61 6d 20 2d 74 65 78 74 20 22 53 6f 72 72 79 cam -text "Sorry
0190: 2c 20 6e 6f 20 63 61 6d 65 72 61 20 66 6f 75 6e , no camera foun
01a0: 64 2e 22 20 2d 66 67 20 72 65 64 20 2d 62 67 20 d." -fg red -bg
01b0: 62 6c 61 63 6b 20 2d 62 64 20 30 0a 20 20 20 20 black -bd 0.
01c0: 70 61 63 6b 20 2e 6e 6f 63 61 6d 20 2d 73 69 64 pack .nocam -sid
01d0: 65 20 74 6f 70 20 2d 66 69 6c 6c 20 62 6f 74 68 e top -fill both
01e0: 20 2d 65 78 70 61 6e 64 20 31 0a 20 20 20 20 72 -expand 1. r
01f0: 65 74 75 72 6e 0a 7d 0a 0a 62 6f 72 67 20 63 61 eturn.}..borg ca
0200: 6d 65 72 61 20 70 61 72 61 6d 65 74 65 72 73 20 mera parameters
0210: 70 72 65 76 69 65 77 2d 73 69 7a 65 20 36 34 30 preview-size 640
0220: 78 34 38 30 0a 73 63 61 6e 20 5b 64 69 63 74 20 x480.scan [dict
0230: 67 65 74 20 5b 62 6f 72 67 20 63 61 6d 65 72 61 get [borg camera
0240: 20 70 61 72 61 6d 65 74 65 72 73 5d 20 70 72 65 parameters] pre
0250: 76 69 65 77 2d 73 69 7a 65 5d 20 22 25 64 78 25 view-size] "%dx%
0260: 64 22 20 77 69 64 74 68 20 68 65 69 67 68 74 0a d" width height.
0270: 0a 23 20 73 63 61 6c 65 20 75 73 65 64 20 66 6f .# scale used fo
0280: 72 20 64 6d 74 78 20 64 65 63 6f 64 65 72 0a 69 r dmtx decoder.i
0290: 66 20 7b 24 77 69 64 74 68 20 3e 20 31 32 38 30 f {$width > 1280
02a0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 69 6d 67 5f } {. set img_
02b0: 73 63 61 6c 65 20 33 0a 20 20 20 20 73 65 74 20 scale 3. set
02c0: 66 6f 6e 74 20 7b 2d 66 61 6d 69 6c 79 20 43 6f font {-family Co
02d0: 75 72 69 65 72 20 2d 73 69 7a 65 20 2d 32 32 20 urier -size -22
02e0: 2d 77 65 69 67 68 74 20 6e 6f 72 6d 61 6c 7d 0a -weight normal}.
02f0: 7d 20 65 6c 73 65 69 66 20 7b 24 77 69 64 74 68 } elseif {$width
0300: 20 3e 20 36 34 30 7d 20 7b 0a 20 20 20 20 73 65 > 640} {. se
0310: 74 20 69 6d 67 5f 73 63 61 6c 65 20 32 0a 20 20 t img_scale 2.
0320: 20 20 73 65 74 20 66 6f 6e 74 20 7b 2d 66 61 6d set font {-fam
0330: 69 6c 79 20 43 6f 75 72 69 65 72 20 2d 73 69 7a ily Courier -siz
0340: 65 20 2d 31 38 20 2d 77 65 69 67 68 74 20 6e 6f e -18 -weight no
0350: 72 6d 61 6c 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 rmal}.} else {.
0360: 20 20 20 73 65 74 20 69 6d 67 5f 73 63 61 6c 65 set img_scale
0370: 20 31 0a 20 20 20 20 73 65 74 20 66 6f 6e 74 20 1. set font
0380: 7b 2d 66 61 6d 69 6c 79 20 43 6f 75 72 69 65 72 {-family Courier
0390: 20 2d 73 69 7a 65 20 2d 31 36 20 2d 77 65 69 67 -size -16 -weig
03a0: 68 74 20 6e 6f 72 6d 61 6c 7d 0a 7d 0a 0a 66 6f ht normal}.}..fo
03b0: 6e 74 20 63 72 65 61 74 65 20 44 4d 43 46 6f 6e nt create DMCFon
03c0: 74 20 7b 2a 7d 24 66 6f 6e 74 0a 73 65 74 20 6d t {*}$font.set m
03d0: 77 69 64 20 5b 66 6f 6e 74 20 6d 65 61 73 75 72 wid [font measur
03e0: 65 20 44 4d 43 46 6f 6e 74 20 22 4d 22 5d 0a 73 e DMCFont "M"].s
03f0: 65 74 20 6c 62 72 6b 20 5b 65 78 70 72 20 72 6f et lbrk [expr ro
0400: 75 6e 64 28 28 31 2e 30 20 2a 20 24 77 69 64 74 und((1.0 * $widt
0410: 68 20 2f 20 24 6d 77 69 64 29 20 2a 20 30 2e 37 h / $mwid) * 0.7
0420: 29 5d 0a 0a 74 6b 70 3a 3a 63 61 6e 76 61 73 20 )]..tkp::canvas
0430: 2e 63 20 2d 77 69 64 74 68 20 24 77 69 64 74 68 .c -width $width
0440: 20 2d 68 65 69 67 68 74 20 24 68 65 69 67 68 74 -height $height
0450: 20 2d 62 67 20 62 6c 61 63 6b 20 2d 62 64 20 30 -bg black -bd 0
0460: 20 5c 0a 20 20 20 20 2d 68 69 67 68 6c 69 67 68 \. -highligh
0470: 74 74 68 69 63 6b 6e 65 73 73 20 30 0a 0a 73 64 tthickness 0..sd
0480: 6c 74 6b 20 72 6f 6f 74 20 24 77 69 64 74 68 20 ltk root $width
0490: 24 68 65 69 67 68 74 0a 0a 70 61 63 6b 20 2e 63 $height..pack .c
04a0: 20 2d 73 69 64 65 20 74 6f 70 0a 0a 69 6d 61 67 -side top..imag
04b0: 65 20 63 72 65 61 74 65 20 70 68 6f 74 6f 20 63 e create photo c
04c0: 61 6d 5f 69 6d 67 0a 69 6d 61 67 65 20 63 72 65 am_img.image cre
04d0: 61 74 65 20 70 68 6f 74 6f 20 6f 6c 64 5f 69 6d ate photo old_im
04e0: 67 0a 63 61 6d 5f 69 6d 67 20 63 6f 6e 66 69 67 g.cam_img config
04f0: 75 72 65 20 2d 77 69 64 74 68 20 36 34 30 20 2d ure -width 640 -
0500: 68 65 69 67 68 74 20 34 38 30 0a 2e 63 20 63 72 height 480..c cr
0510: 65 61 74 65 20 69 6d 61 67 65 20 30 20 30 20 2d eate image 0 0 -
0520: 61 6e 63 68 6f 72 20 6e 77 20 2d 69 6d 61 67 65 anchor nw -image
0530: 20 63 61 6d 5f 69 6d 67 0a 2e 63 20 63 72 65 61 cam_img..c crea
0540: 74 65 20 74 65 78 74 20 5b 65 78 70 72 20 7b 24 te text [expr {$
0550: 77 69 64 74 68 20 2f 20 32 7d 5d 20 5b 65 78 70 width / 2}] [exp
0560: 72 20 7b 24 68 65 69 67 68 74 20 2f 20 33 7d 5d r {$height / 3}]
0570: 20 5c 0a 20 20 20 20 2d 66 69 6c 6c 20 23 46 46 \. -fill #FF
0580: 46 46 46 46 20 2d 74 61 67 73 20 64 61 74 61 20 FFFF -tags data
0590: 2d 61 6e 63 68 6f 72 20 63 65 6e 74 65 72 20 2d -anchor center -
05a0: 66 6f 6e 74 20 44 4d 43 46 6f 6e 74 20 2d 6a 75 font DMCFont -ju
05b0: 73 74 69 66 79 20 6c 65 66 74 0a 0a 62 69 6e 64 stify left..bind
05c0: 20 2e 63 20 3c 31 3e 20 73 74 61 72 74 5f 73 74 .c <1> start_st
05d0: 6f 70 0a 62 69 6e 64 20 2e 20 3c 3c 49 6d 61 67 op.bind . <<Imag
05e0: 65 43 61 70 74 75 72 65 3e 3e 20 7b 64 6f 5f 63 eCapture>> {do_c
05f0: 61 70 74 75 72 65 20 25 78 7d 0a 0a 70 72 6f 63 apture %x}..proc
0600: 20 64 6f 5f 63 61 70 74 75 72 65 20 7b 66 6c 61 do_capture {fla
0610: 67 7d 20 7b 0a 20 20 20 20 69 66 20 7b 24 66 6c g} {. if {$fl
0620: 61 67 7d 20 7b 0a 09 62 6f 72 67 20 63 61 6d 65 ag} {..borg came
0630: 72 61 20 67 72 65 79 69 6d 61 67 65 20 63 61 6d ra greyimage cam
0640: 5f 69 6d 67 0a 09 69 66 20 7b 21 5b 63 61 74 63 _img..if {![catc
0650: 68 20 7b 64 6d 74 78 3a 3a 61 73 79 6e 63 5f 64 h {dmtx::async_d
0660: 65 63 6f 64 65 20 63 61 6d 5f 69 6d 67 20 64 65 ecode cam_img de
0670: 63 5f 64 6f 6e 65 20 24 3a 3a 69 6d 67 5f 73 63 c_done $::img_sc
0680: 61 6c 65 7d 20 65 72 72 5d 7d 20 7b 0a 09 20 20 ale} err]} {..
0690: 20 20 6f 6c 64 5f 69 6d 67 20 63 6f 70 79 20 63 old_img copy c
06a0: 61 6d 5f 69 6d 67 20 2d 63 6f 6d 70 6f 73 69 74 am_img -composit
06b0: 69 6e 67 72 75 6c 65 20 73 65 74 0a 09 7d 0a 20 ingrule set..}.
06c0: 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 64 65 63 }.}..proc dec
06d0: 5f 64 6f 6e 65 20 7b 66 6c 61 67 20 74 69 6d 65 _done {flag time
06e0: 20 64 61 74 61 7d 20 7b 0a 20 20 20 20 69 66 20 data} {. if
06f0: 7b 24 66 6c 61 67 20 26 26 20 28 5b 62 6f 72 67 {$flag && ([borg
0700: 20 63 61 6d 65 72 61 20 73 74 61 74 65 5d 20 65 camera state] e
0710: 71 20 22 63 61 70 74 75 72 65 22 29 7d 20 7b 0a q "capture")} {.
0720: 09 62 6f 72 67 20 63 61 6d 65 72 61 20 73 74 6f .borg camera sto
0730: 70 0a 09 63 61 6d 5f 69 6d 67 20 63 6f 70 79 20 p..cam_img copy
0740: 6f 6c 64 5f 69 6d 67 20 2d 63 6f 6d 70 6f 73 69 old_img -composi
0750: 74 69 6e 67 72 75 6c 65 20 73 65 74 0a 09 73 65 tingrule set..se
0760: 74 20 70 64 61 74 61 20 24 64 61 74 61 0a 09 72 t pdata $data..r
0770: 65 67 73 75 62 20 2d 61 6c 6c 20 7b 5b 5b 3a 63 egsub -all {[[:c
0780: 6e 74 72 6c 3a 5d 5d 7d 20 24 70 64 61 74 61 20 ntrl:]]} $pdata
0790: 22 20 22 20 70 64 61 74 61 0a 09 73 65 74 20 70 " " pdata..set p
07a0: 72 64 61 74 61 20 22 22 0a 09 77 68 69 6c 65 20 rdata ""..while
07b0: 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 {[string length
07c0: 24 70 64 61 74 61 5d 7d 20 7b 0a 09 20 20 20 20 $pdata]} {..
07d0: 61 70 70 65 6e 64 20 70 72 64 61 74 61 20 5b 73 append prdata [s
07e0: 74 72 69 6e 67 20 72 61 6e 67 65 20 24 70 64 61 tring range $pda
07f0: 74 61 20 30 20 24 7b 3a 3a 6c 62 72 6b 7d 2d 31 ta 0 ${::lbrk}-1
0800: 5d 20 22 5c 6e 22 0a 09 20 20 20 20 73 65 74 20 ] "\n".. set
0810: 70 64 61 74 61 20 5b 73 74 72 69 6e 67 20 72 61 pdata [string ra
0820: 6e 67 65 20 24 70 64 61 74 61 20 24 3a 3a 6c 62 nge $pdata $::lb
0830: 72 6b 20 65 6e 64 5d 0a 09 7d 0a 09 61 70 70 65 rk end]..}..appe
0840: 6e 64 20 70 72 64 61 74 61 20 22 5c 6e 24 74 69 nd prdata "\n$ti
0850: 6d 65 20 6d 73 22 0a 09 2e 63 20 69 74 65 6d 63 me ms"...c itemc
0860: 6f 6e 66 69 67 75 72 65 20 64 61 74 61 20 2d 74 onfigure data -t
0870: 65 78 74 20 24 70 72 64 61 74 61 0a 09 6c 61 73 ext $prdata..las
0880: 73 69 67 6e 20 5b 2e 63 20 62 62 6f 78 20 64 61 sign [.c bbox da
0890: 74 61 5d 20 78 31 20 79 31 20 78 32 20 79 32 0a ta] x1 y1 x2 y2.
08a0: 09 73 65 74 20 78 31 20 5b 65 78 70 72 20 7b 24 .set x1 [expr {$
08b0: 78 31 20 2d 20 24 3a 3a 6d 77 69 64 7d 5d 0a 09 x1 - $::mwid}]..
08c0: 73 65 74 20 79 31 20 5b 65 78 70 72 20 7b 24 79 set y1 [expr {$y
08d0: 31 20 2d 20 24 3a 3a 6d 77 69 64 7d 5d 0a 09 73 1 - $::mwid}]..s
08e0: 65 74 20 78 32 20 5b 65 78 70 72 20 7b 24 78 32 et x2 [expr {$x2
08f0: 20 2b 20 24 3a 3a 6d 77 69 64 7d 5d 0a 09 73 65 + $::mwid}]..se
0900: 74 20 79 32 20 5b 65 78 70 72 20 7b 24 79 32 20 t y2 [expr {$y2
0910: 2b 20 24 3a 3a 6d 77 69 64 7d 5d 0a 09 2e 63 20 + $::mwid}]...c
0920: 63 72 65 61 74 65 20 70 72 65 63 74 20 24 78 31 create prect $x1
0930: 20 24 79 31 20 24 78 32 20 24 79 32 20 2d 66 69 $y1 $x2 $y2 -fi
0940: 6c 6c 20 23 36 36 36 36 36 36 20 2d 73 74 72 6f ll #666666 -stro
0950: 6b 65 20 23 46 46 46 46 46 46 20 5c 0a 09 20 20 ke #FFFFFF \..
0960: 20 20 2d 66 69 6c 6c 6f 70 61 63 69 74 79 20 30 -fillopacity 0
0970: 2e 37 20 2d 73 74 72 6f 6b 65 77 69 64 74 68 20 .7 -strokewidth
0980: 31 20 2d 74 61 67 73 20 64 61 74 61 62 67 0a 09 1 -tags databg..
0990: 2e 63 20 6c 6f 77 65 72 20 64 61 74 61 62 67 20 .c lower databg
09a0: 64 61 74 61 0a 09 62 6f 72 67 20 76 69 62 72 61 data..borg vibra
09b0: 74 65 20 31 30 30 0a 09 62 6f 72 67 20 62 65 65 te 100..borg bee
09c0: 70 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 p. }.}..proc
09d0: 73 74 61 72 74 5f 73 74 6f 70 20 7b 7d 20 7b 0a start_stop {} {.
09e0: 20 20 20 20 69 66 20 7b 5b 62 6f 72 67 20 63 61 if {[borg ca
09f0: 6d 65 72 61 20 73 74 61 74 65 5d 20 6e 65 20 22 mera state] ne "
0a00: 63 61 70 74 75 72 65 22 7d 20 7b 0a 09 62 6f 72 capture"} {..bor
0a10: 67 20 63 61 6d 65 72 61 20 73 74 61 72 74 0a 09 g camera start..
0a20: 2e 63 20 69 74 65 6d 63 6f 6e 66 69 67 75 72 65 .c itemconfigure
0a30: 20 64 61 74 61 20 2d 74 65 78 74 20 22 22 0a 09 data -text ""..
0a40: 2e 63 20 64 65 6c 65 74 65 20 64 61 74 61 62 67 .c delete databg
0a50: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 64 . } else {..d
0a60: 6d 74 78 3a 3a 61 73 79 6e 63 5f 64 65 63 6f 64 mtx::async_decod
0a70: 65 20 61 62 6f 72 74 0a 09 62 6f 72 67 20 63 61 e abort..borg ca
0a80: 6d 65 72 61 20 73 74 6f 70 0a 20 20 20 20 7d 0a mera stop. }.
0a90: 7d 0a 0a 70 72 6f 63 20 64 6f 5f 70 61 75 73 65 }..proc do_pause
0aa0: 20 7b 7d 20 7b 0a 20 20 20 20 64 6d 74 78 3a 3a {} {. dmtx::
0ab0: 61 73 79 6e 63 5f 64 65 63 6f 64 65 20 73 74 6f async_decode sto
0ac0: 70 0a 20 20 20 20 62 6f 72 67 20 63 61 6d 65 72 p. borg camer
0ad0: 61 20 73 74 6f 70 0a 7d 0a 0a 62 6f 72 67 20 63 a stop.}..borg c
0ae0: 61 6d 65 72 61 20 73 74 61 72 74 0a amera start.