Hex Artifact Content
Not logged in

Artifact 4ce598aa1fc82dc9a41a04992a94673cb4d863af:


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.