Hex Artifact Content
Not logged in

Artifact ade494d56814fc1ba5d72886ee3233f7bed44de0:


0000: 23 20 41 6e 64 72 6f 69 64 20 64 65 6d 6f 20 66  # Android demo f
0010: 6f 72 20 63 61 6d 65 72 61 3a 20 73 69 6d 70 6c  or camera: simpl
0020: 65 20 77 65 62 63 61 6d 20 6f 76 65 72 20 77 69  e webcam over wi
0030: 66 69 0a 0a 73 65 74 20 3a 3a 70 6f 72 74 20 38  fi..set ::port 8
0040: 30 38 30 0a 70 61 63 6b 61 67 65 20 72 65 71 75  080.package requ
0050: 69 72 65 20 74 6b 70 61 74 68 0a 73 64 6c 74 6b  ire tkpath.sdltk
0060: 20 73 63 72 65 65 6e 73 61 76 65 72 20 30 0a 77   screensaver 0.w
0070: 6d 20 61 74 74 72 69 62 75 74 65 73 20 2e 20 2d  m attributes . -
0080: 66 75 6c 6c 73 63 72 65 65 6e 20 31 0a 2e 20 63  fullscreen 1.. c
0090: 6f 6e 66 69 67 75 72 65 20 2d 62 67 20 22 23 32  onfigure -bg "#2
00a0: 30 32 30 32 30 22 0a 62 69 6e 64 20 61 6c 6c 20  02020".bind all 
00b0: 3c 42 72 65 61 6b 3e 20 65 78 69 74 0a 62 69 6e  <Break> exit.bin
00c0: 64 20 2e 20 3c 43 6f 6e 66 69 67 75 72 65 3e 20  d . <Configure> 
00d0: 63 61 6d 72 6f 74 61 74 65 0a 0a 70 72 6f 63 20  camrotate..proc 
00e0: 63 61 6d 72 6f 74 61 74 65 20 7b 7d 20 7b 0a 20  camrotate {} {. 
00f0: 20 20 20 62 6f 72 67 20 63 61 6d 65 72 61 20 6f     borg camera o
0100: 72 69 65 6e 74 61 74 69 6f 6e 20 5b 64 69 63 74  rientation [dict
0110: 20 67 65 74 20 5b 62 6f 72 67 20 64 69 73 70 6c   get [borg displ
0120: 61 79 6d 65 74 72 69 63 73 5d 20 72 6f 74 61 74  aymetrics] rotat
0130: 69 6f 6e 5d 0a 20 20 20 20 69 6d 67 20 62 6c 61  ion].    img bla
0140: 6e 6b 0a 20 20 20 20 69 6d 67 20 63 6f 6e 66 69  nk.    img confi
0150: 67 75 72 65 20 2d 77 69 64 74 68 20 31 20 2d 68  gure -width 1 -h
0160: 65 69 67 68 74 20 31 0a 20 20 20 20 69 6d 67 20  eight 1.    img 
0170: 63 6f 6e 66 69 67 75 72 65 20 2d 77 69 64 74 68  configure -width
0180: 20 30 20 2d 68 65 69 67 68 74 20 30 0a 20 20 20   0 -height 0.   
0190: 20 2e 63 20 63 6f 6f 72 64 73 20 69 6d 67 20 5b   .c coords img [
01a0: 65 78 70 72 20 7b 5b 77 69 6e 66 6f 20 73 63 72  expr {[winfo scr
01b0: 65 65 6e 77 69 64 74 68 20 2e 5d 20 2f 20 32 7d  eenwidth .] / 2}
01c0: 5d 20 5c 0a 09 5b 65 78 70 72 20 7b 5b 77 69 6e  ] \..[expr {[win
01d0: 66 6f 20 73 63 72 65 65 6e 68 65 69 67 68 74 20  fo screenheight 
01e0: 2e 5d 20 2f 20 32 7d 5d 0a 20 20 20 20 2e 63 20  .] / 2}].    .c 
01f0: 63 6f 6f 72 64 73 20 74 78 74 20 5b 65 78 70 72  coords txt [expr
0200: 20 7b 5b 77 69 6e 66 6f 20 73 63 72 65 65 6e 77   {[winfo screenw
0210: 69 64 74 68 20 2e 5d 20 2f 20 32 7d 5d 20 5c 0a  idth .] / 2}] \.
0220: 09 5b 65 78 70 72 20 7b 5b 77 69 6e 66 6f 20 73  .[expr {[winfo s
0230: 63 72 65 65 6e 68 65 69 67 68 74 20 2e 5d 20 2d  creenheight .] -
0240: 20 37 30 7d 5d 0a 7d 0a 0a 70 72 6f 63 20 72 65   70}].}..proc re
0250: 71 75 65 73 74 20 7b 73 6f 63 6b 20 61 72 67 73  quest {sock args
0260: 7d 20 7b 0a 20 20 20 20 63 68 61 6e 20 63 6f 6e  } {.    chan con
0270: 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 74 72  figure $sock -tr
0280: 61 6e 73 6c 61 74 69 6f 6e 20 62 69 6e 61 72 79  anslation binary
0290: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75   -blocking 0 -bu
02a0: 66 66 65 72 69 6e 67 20 6e 6f 6e 65 0a 20 20 20  ffering none.   
02b0: 20 69 66 20 7b 5b 62 69 6e 64 20 2e 20 3c 3c 50   if {[bind . <<P
02c0: 69 63 74 75 72 65 54 61 6b 65 6e 3e 3e 5d 20 6e  ictureTaken>>] n
02d0: 65 20 22 22 7d 20 7b 0a 09 63 68 61 6e 20 63 6c  e ""} {..chan cl
02e0: 6f 73 65 20 24 73 6f 63 6b 0a 09 72 65 74 75 72  ose $sock..retur
02f0: 6e 0a 20 20 20 20 7d 0a 20 20 20 20 61 66 74 65  n.    }.    afte
0300: 72 20 31 30 30 0a 20 20 20 20 63 61 74 63 68 20  r 100.    catch 
0310: 7b 63 68 61 6e 20 72 65 61 64 20 24 73 6f 63 6b  {chan read $sock
0320: 20 31 30 30 30 7d 20 65 72 72 0a 20 20 20 20 62   1000} err.    b
0330: 6f 72 67 20 63 61 6d 65 72 61 20 70 61 72 61 6d  org camera param
0340: 65 74 65 72 73 20 72 6f 74 61 74 69 6f 6e 20 5b  eters rotation [
0350: 64 69 63 74 20 67 65 74 20 5b 62 6f 72 67 20 64  dict get [borg d
0360: 69 73 70 6c 61 79 6d 65 74 72 69 63 73 5d 20 72  isplaymetrics] r
0370: 6f 74 61 74 69 6f 6e 5d 0a 20 20 20 20 69 66 20  otation].    if 
0380: 7b 21 5b 62 6f 72 67 20 63 61 6d 65 72 61 20 74  {![borg camera t
0390: 61 6b 65 6a 70 65 67 5d 7d 20 7b 0a 09 63 68 61  akejpeg]} {..cha
03a0: 6e 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 09 62  n close $sock..b
03b0: 6f 72 67 20 63 61 6d 65 72 61 20 70 61 72 61 6d  org camera param
03c0: 65 74 65 72 73 20 72 6f 74 61 74 69 6f 6e 20 30  eters rotation 0
03d0: 0a 09 62 6f 72 67 20 63 61 6d 65 72 61 20 73 74  ..borg camera st
03e0: 61 72 74 0a 09 72 65 74 75 72 6e 0a 20 20 20 20  art..return.    
03f0: 7d 0a 20 20 20 20 62 69 6e 64 20 2e 20 3c 3c 50  }.    bind . <<P
0400: 69 63 74 75 72 65 54 61 6b 65 6e 3e 3e 20 5b 6c  ictureTaken>> [l
0410: 69 73 74 20 73 65 6e 64 5f 6a 70 65 67 20 24 73  ist send_jpeg $s
0420: 6f 63 6b 5d 0a 20 20 20 20 63 68 61 6e 20 63 6f  ock].    chan co
0430: 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62  nfigure $sock -b
0440: 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 63 68  locking 1.    ch
0450: 61 6e 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69  an puts -nonewli
0460: 6e 65 20 24 73 6f 63 6b 20 5c 0a 20 20 22 48 54  ne $sock \.  "HT
0470: 54 50 2f 31 2e 30 20 32 30 30 20 4f 4b 5c 72 5c  TP/1.0 200 OK\r\
0480: 6e 43 6f 6e 6e 65 63 74 69 6f 6e 3a 20 63 6c 6f  nConnection: clo
0490: 73 65 5c 72 5c 6e 43 6f 6e 74 65 6e 74 2d 54 79  se\r\nContent-Ty
04a0: 70 65 3a 20 69 6d 61 67 65 2f 6a 70 65 67 5c 72  pe: image/jpeg\r
04b0: 5c 6e 5c 72 5c 6e 22 0a 7d 0a 0a 70 72 6f 63 20  \n\r\n".}..proc 
04c0: 73 65 6e 64 5f 6a 70 65 67 20 7b 73 6f 63 6b 7d  send_jpeg {sock}
04d0: 20 7b 0a 20 20 20 20 62 69 6e 64 20 2e 20 3c 3c   {.    bind . <<
04e0: 50 69 63 74 75 72 65 54 61 6b 65 6e 3e 3e 20 7b  PictureTaken>> {
04f0: 7d 0a 20 20 20 20 63 61 74 63 68 20 7b 63 68 61  }.    catch {cha
0500: 6e 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e  n puts -nonewlin
0510: 65 20 24 73 6f 63 6b 20 5b 62 6f 72 67 20 63 61  e $sock [borg ca
0520: 6d 65 72 61 20 6a 70 65 67 5d 7d 0a 20 20 20 20  mera jpeg]}.    
0530: 63 61 74 63 68 20 7b 63 68 61 6e 20 63 6c 6f 73  catch {chan clos
0540: 65 20 24 73 6f 63 6b 7d 0a 20 20 20 20 62 6f 72  e $sock}.    bor
0550: 67 20 63 61 6d 65 72 61 20 70 61 72 61 6d 65 74  g camera paramet
0560: 65 72 73 20 72 6f 74 61 74 69 6f 6e 20 30 0a 20  ers rotation 0. 
0570: 20 20 20 62 6f 72 67 20 63 61 6d 65 72 61 20 73     borg camera s
0580: 74 61 72 74 0a 7d 0a 0a 70 72 6f 63 20 6e 65 74  tart.}..proc net
0590: 73 74 61 74 20 7b 7d 20 7b 0a 20 20 20 20 73 65  stat {} {.    se
05a0: 74 20 75 72 6c 20 4f 46 46 4c 49 4e 45 0a 20 20  t url OFFLINE.  
05b0: 20 20 73 65 74 20 63 6f 6c 20 72 65 64 0a 20 20    set col red.  
05c0: 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61    if {[string ma
05d0: 74 63 68 20 22 77 69 66 69 2a 22 20 5b 62 6f 72  tch "wifi*" [bor
05e0: 67 20 6e 65 74 77 6f 72 6b 69 6e 66 6f 5d 5d 7d  g networkinfo]]}
05f0: 20 7b 0a 09 73 65 74 20 77 69 66 69 20 5b 62 6f   {..set wifi [bo
0600: 72 67 20 73 79 73 74 65 6d 70 72 6f 70 65 72 74  rg systempropert
0610: 69 65 73 20 77 69 66 69 2e 69 6e 74 65 72 66 61  ies wifi.interfa
0620: 63 65 5d 0a 09 69 66 20 7b 21 5b 63 61 74 63 68  ce]..if {![catch
0630: 20 7b 73 65 74 20 69 70 20 5b 62 6f 72 67 20 73   {set ip [borg s
0640: 79 73 74 65 6d 70 72 6f 70 65 72 74 69 65 73 20  ystemproperties 
0650: 64 68 63 70 2e 24 7b 77 69 66 69 7d 2e 69 70 61  dhcp.${wifi}.ipa
0660: 64 64 72 65 73 73 5d 7d 5d 20 26 26 0a 09 20 20  ddress]}] &&..  
0670: 20 20 28 24 69 70 20 6e 65 20 22 22 29 7d 20 7b    ($ip ne "")} {
0680: 0a 09 20 20 20 20 73 65 74 20 75 72 6c 20 22 68  ..    set url "h
0690: 74 74 70 3a 2f 2f 24 7b 69 70 7d 3a 24 7b 3a 3a  ttp://${ip}:${::
06a0: 70 6f 72 74 7d 2f 22 0a 09 20 20 20 20 73 65 74  port}/"..    set
06b0: 20 63 6f 6c 20 67 72 65 65 6e 0a 09 20 20 20 20   col green..    
06c0: 75 6e 73 65 74 20 77 69 66 69 0a 09 7d 0a 20 20  unset wifi..}.  
06d0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 61 72 72 61    } else {..arra
06e0: 79 20 73 65 74 20 74 20 5b 62 6f 72 67 20 74 65  y set t [borg te
06f0: 74 68 65 72 69 6e 66 6f 5d 0a 09 69 66 20 7b 24  therinfo]..if {$
0700: 74 28 61 63 74 69 76 65 29 20 6e 65 20 22 22 7d  t(active) ne ""}
0710: 20 7b 0a 09 20 20 20 20 63 61 74 63 68 20 7b 73   {..    catch {s
0720: 65 74 20 77 69 66 69 20 5b 62 6f 72 67 20 73 79  et wifi [borg sy
0730: 73 74 65 6d 70 72 6f 70 65 72 74 69 65 73 20 77  stemproperties w
0740: 69 66 69 2e 74 65 74 68 65 72 69 6e 67 2e 69 6e  ifi.tethering.in
0750: 74 65 72 66 61 63 65 5d 7d 0a 09 20 20 20 20 69  terface]}..    i
0760: 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73  f {![info exists
0770: 20 77 69 66 69 5d 7d 20 7b 0a 09 09 73 65 74 20   wifi]} {...set 
0780: 77 69 66 69 20 24 74 28 61 63 74 69 76 65 29 0a  wifi $t(active).
0790: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a  .    }..}.    }.
07a0: 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78      if {[info ex
07b0: 69 73 74 73 20 77 69 66 69 5d 7d 20 7b 0a 09 63  ists wifi]} {..c
07c0: 61 74 63 68 20 7b 0a 09 20 20 20 20 73 65 74 20  atch {..    set 
07d0: 69 70 20 5b 65 78 65 63 20 69 66 63 6f 6e 66 69  ip [exec ifconfi
07e0: 67 20 24 77 69 66 69 5d 0a 09 20 20 20 20 73 65  g $wifi]..    se
07f0: 74 20 69 20 5b 6c 73 65 61 72 63 68 20 24 69 70  t i [lsearch $ip
0800: 20 69 70 5d 0a 09 20 20 20 20 69 66 20 7b 24 69   ip]..    if {$i
0810: 20 3e 20 30 7d 20 7b 0a 09 09 73 65 74 20 69 70   > 0} {...set ip
0820: 20 5b 6c 69 6e 64 65 78 20 24 69 70 20 24 69 2b   [lindex $ip $i+
0830: 31 5d 0a 09 09 73 65 74 20 75 72 6c 20 22 68 74  1]...set url "ht
0840: 74 70 3a 2f 2f 24 7b 69 70 7d 3a 24 7b 3a 3a 70  tp://${ip}:${::p
0850: 6f 72 74 7d 2f 22 0a 09 09 73 65 74 20 63 6f 6c  ort}/"...set col
0860: 20 67 72 65 65 6e 0a 09 20 20 20 20 7d 0a 09 7d   green..    }..}
0870: 0a 20 20 20 20 7d 0a 20 20 20 20 2e 63 20 69 74  .    }.    .c it
0880: 65 6d 63 6f 6e 66 69 67 75 72 65 20 74 78 74 20  emconfigure txt 
0890: 2d 74 65 78 74 20 24 75 72 6c 20 2d 73 74 72 6f  -text $url -stro
08a0: 6b 65 20 24 63 6f 6c 0a 7d 0a 0a 69 6d 61 67 65  ke $col.}..image
08b0: 20 63 72 65 61 74 65 20 70 68 6f 74 6f 20 69 6d   create photo im
08c0: 67 0a 62 69 6e 64 20 2e 20 3c 3c 49 6d 61 67 65  g.bind . <<Image
08d0: 43 61 70 74 75 72 65 3e 3e 20 7b 62 6f 72 67 20  Capture>> {borg 
08e0: 63 61 6d 65 72 61 20 69 6d 61 67 65 20 69 6d 67  camera image img
08f0: 7d 0a 62 69 6e 64 20 2e 20 3c 3c 4e 65 74 77 6f  }.bind . <<Netwo
0900: 72 6b 49 6e 66 6f 3e 3e 20 6e 65 74 73 74 61 74  rkInfo>> netstat
0910: 0a 62 69 6e 64 20 2e 20 3c 3c 54 65 74 68 65 72  .bind . <<Tether
0920: 49 6e 66 6f 3e 3e 20 6e 65 74 73 74 61 74 0a 70  Info>> netstat.p
0930: 61 63 6b 20 5b 74 6b 70 3a 3a 63 61 6e 76 61 73  ack [tkp::canvas
0940: 20 2e 63 20 2d 62 64 20 30 20 2d 68 69 67 68 6c   .c -bd 0 -highl
0950: 69 67 68 74 74 68 69 63 6b 6e 65 73 73 20 30 20  ightthickness 0 
0960: 2d 62 67 20 22 23 32 30 32 30 32 30 22 5d 20 5c  -bg "#202020"] \
0970: 0a 20 20 20 20 2d 73 69 64 65 20 74 6f 70 20 2d  .    -side top -
0980: 66 69 6c 6c 20 62 6f 74 68 20 2d 65 78 70 61 6e  fill both -expan
0990: 64 20 31 0a 2e 63 20 63 72 65 61 74 65 20 69 6d  d 1..c create im
09a0: 61 67 65 20 30 20 30 20 2d 69 6d 61 67 65 20 69  age 0 0 -image i
09b0: 6d 67 20 2d 61 6e 63 68 6f 72 20 63 20 2d 74 61  mg -anchor c -ta
09c0: 67 73 20 69 6d 67 0a 2e 63 20 63 72 65 61 74 65  gs img..c create
09d0: 20 70 74 65 78 74 20 30 20 30 20 2d 66 6f 6e 74   ptext 0 0 -font
09e0: 66 61 6d 69 6c 79 20 48 65 6c 76 65 74 69 63 61  family Helvetica
09f0: 20 2d 66 6f 6e 74 73 69 7a 65 20 34 30 20 2d 66   -fontsize 40 -f
0a00: 69 6c 6c 20 77 68 69 74 65 20 5c 0a 20 20 20 2d  ill white \.   -
0a10: 66 69 6c 6c 6f 70 61 63 69 74 79 20 30 2e 38 20  fillopacity 0.8 
0a20: 2d 73 74 72 6f 6b 65 20 72 65 64 20 2d 73 74 72  -stroke red -str
0a30: 6f 6b 65 6f 70 61 63 69 74 79 20 30 2e 38 20 2d  okeopacity 0.8 -
0a40: 73 74 72 6f 6b 65 77 69 64 74 68 20 35 20 5c 0a  strokewidth 5 \.
0a50: 20 20 20 2d 66 69 6c 6c 6f 76 65 72 73 74 72 6f     -filloverstro
0a60: 6b 65 20 31 20 2d 74 65 78 74 61 6e 63 68 6f 72  ke 1 -textanchor
0a70: 20 63 20 2d 74 61 67 73 20 74 78 74 0a 73 6f 63   c -tags txt.soc
0a80: 6b 65 74 20 2d 73 65 72 76 65 72 20 72 65 71 75  ket -server requ
0a90: 65 73 74 20 24 3a 3a 70 6f 72 74 0a 61 66 74 65  est $::port.afte
0aa0: 72 20 69 64 6c 65 20 6e 65 74 73 74 61 74 0a 61  r idle netstat.a
0ab0: 66 74 65 72 20 69 64 6c 65 20 63 61 6d 72 6f 74  fter idle camrot
0ac0: 61 74 65 0a 62 6f 72 67 20 63 61 6d 65 72 61 20  ate.borg camera 
0ad0: 6f 70 65 6e 0a 62 6f 72 67 20 63 61 6d 65 72 61  open.borg camera
0ae0: 20 70 61 72 61 6d 65 74 65 72 73 20 70 69 63 74   parameters pict
0af0: 75 72 65 2d 73 69 7a 65 20 36 34 30 78 34 38 30  ure-size 640x480
0b00: 20 6a 70 65 67 2d 71 75 61 6c 69 74 79 20 38 30   jpeg-quality 80
0b10: 20 72 6f 74 61 74 69 6f 6e 20 30 0a 62 6f 72 67   rotation 0.borg
0b20: 20 63 61 6d 65 72 61 20 73 74 61 72 74            camera start