Hex Artifact Content
Not logged in

Artifact e3892410b86641a57a9f9238f726148d4e6ed415:


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.