Hex Artifact Content
Not logged in

Artifact d0f68f21fb0e44bbe3f0a2ea60fec938efb8aac6:


0000: 23 21 20 2f 62 69 6e 2f 73 68 0a 23 20 54 68 65  #! /bin/sh.# The
0010: 20 6e 65 78 74 20 6c 69 6e 65 20 72 65 73 74 61   next line resta
0020: 72 74 73 20 75 73 69 6e 67 20 74 63 6c 73 68 20  rts using tclsh 
0030: 5c 0a 65 78 65 63 20 74 63 6c 73 68 20 22 24 30  \.exec tclsh "$0
0040: 22 20 24 7b 31 2b 22 24 40 22 7d 0a 0a 70 61 63  " ${1+"$@"}..pac
0050: 6b 61 67 65 20 72 65 71 75 69 72 65 20 54 6b 0a  kage require Tk.
0060: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20  package require 
0070: 49 6d 67 0a 70 61 63 6b 61 67 65 20 72 65 71 75  Img.package requ
0080: 69 72 65 20 43 61 6e 76 61 73 33 64 0a 0a 77 6d  ire Canvas3d..wm
0090: 20 61 74 74 72 69 62 75 74 65 73 20 2e 20 2d 66   attributes . -f
00a0: 75 6c 6c 73 63 72 65 65 6e 20 31 0a 63 61 6e 76  ullscreen 1.canv
00b0: 61 73 33 64 20 2e 77 31 0a 70 61 63 6b 20 2e 77  as3d .w1.pack .w
00c0: 31 20 2d 65 78 70 61 6e 64 20 79 65 73 20 2d 66  1 -expand yes -f
00d0: 69 6c 6c 20 62 6f 74 68 20 2d 73 69 64 65 20 6c  ill both -side l
00e0: 65 66 74 0a 2e 77 31 20 63 6f 6e 66 69 67 75 72  eft..w1 configur
00f0: 65 20 2d 77 69 64 74 68 20 33 30 30 20 2d 68 65  e -width 300 -he
0100: 69 67 68 74 20 33 30 30 20 2d 62 61 63 6b 67 72  ight 300 -backgr
0110: 6f 75 6e 64 20 62 6c 61 63 6b 0a 0a 62 69 6e 64  ound black..bind
0120: 20 61 6c 6c 20 3c 42 72 65 61 6b 3e 20 65 78 69   all <Break> exi
0130: 74 0a 0a 23 20 43 61 6d 65 72 61 20 63 6f 6e 74  t..# Camera cont
0140: 72 6f 6c 0a 70 72 6f 63 20 54 20 7b 77 20 61 72  rol.proc T {w ar
0150: 67 73 7d 20 7b 0a 20 20 20 20 24 77 20 74 72 61  gs} {.    $w tra
0160: 6e 73 66 6f 72 6d 20 2d 63 61 6d 65 72 61 20 74  nsform -camera t
0170: 79 70 65 28 6c 69 67 68 74 29 20 24 61 72 67 73  ype(light) $args
0180: 0a 20 20 20 20 24 77 20 64 65 6c 65 74 65 20 43  .    $w delete C
0190: 61 6d 65 72 61 53 74 72 69 6e 67 0a 7d 0a 0a 23  ameraString.}..#
01a0: 20 4d 6f 75 73 65 20 63 6f 6e 74 72 6f 6c 0a 62   Mouse control.b
01b0: 69 6e 64 20 2e 77 31 20 3c 42 31 2d 4d 6f 74 69  ind .w1 <B1-Moti
01c0: 6f 6e 3e 20 7b 0a 20 20 20 20 73 65 74 20 72 79  on> {.    set ry
01d0: 20 5b 65 78 70 72 20 33 36 30 2e 30 20 2a 20 28   [expr 360.0 * (
01e0: 25 79 20 20 2d 20 24 3a 3a 59 29 20 2f 20 5b 25  %y  - $::Y) / [%
01f0: 57 20 63 67 65 74 20 2d 68 65 69 67 68 74 5d 5d  W cget -height]]
0200: 0a 20 20 20 20 73 65 74 20 72 78 20 5b 65 78 70  .    set rx [exp
0210: 72 20 33 36 30 2e 30 20 2a 20 28 25 78 20 20 2d  r 360.0 * (%x  -
0220: 20 24 3a 3a 58 29 20 2f 20 5b 25 57 20 63 67 65   $::X) / [%W cge
0230: 74 20 2d 77 69 64 74 68 5d 5d 0a 20 20 20 20 54  t -width]].    T
0240: 20 25 57 20 6f 72 62 69 74 75 70 20 24 72 79 20   %W orbitup $ry 
0250: 6f 72 62 69 74 6c 65 66 74 20 24 72 78 0a 20 20  orbitleft $rx.  
0260: 20 20 73 65 74 20 3a 3a 58 20 25 78 0a 20 20 20    set ::X %x.   
0270: 20 73 65 74 20 3a 3a 59 20 25 79 0a 7d 0a 62 69   set ::Y %y.}.bi
0280: 6e 64 20 2e 77 31 20 3c 31 3e 20 7b 0a 20 20 20  nd .w1 <1> {.   
0290: 20 73 65 74 20 3a 3a 58 20 25 78 0a 20 20 20 20   set ::X %x.    
02a0: 73 65 74 20 3a 3a 59 20 25 79 0a 7d 0a 0a 62 69  set ::Y %y.}..bi
02b0: 6e 64 20 2e 77 31 20 3c 44 6f 75 62 6c 65 2d 31  nd .w1 <Double-1
02c0: 3e 20 7b 0a 20 20 20 20 2e 77 31 20 64 65 6c 65  > {.    .w1 dele
02d0: 74 65 20 74 78 74 0a 20 20 20 20 69 6d 67 66 65  te txt.    imgfe
02e0: 74 63 68 20 25 57 20 25 78 20 25 79 0a 7d 0a 0a  tch %W %x %y.}..
02f0: 70 72 6f 63 20 69 6d 67 66 65 74 63 68 20 7b 77  proc imgfetch {w
0300: 20 78 20 79 7d 20 7b 0a 20 20 20 20 66 6f 72 65   x y} {.    fore
0310: 61 63 68 20 69 64 20 5b 24 77 20 66 69 6e 64 20  ach id [$w find 
0320: 2d 73 6f 72 74 62 79 64 65 70 74 68 20 76 69 65  -sortbydepth vie
0330: 77 70 6f 72 74 28 24 78 2c 24 79 29 5d 20 7b 0a  wport($x,$y)] {.
0340: 09 73 65 74 20 74 61 67 20 5b 24 77 20 67 65 74  .set tag [$w get
0350: 74 61 67 20 24 69 64 5d 0a 09 69 66 20 7b 5b 73  tag $id]..if {[s
0360: 74 72 69 6e 67 20 6d 61 74 63 68 20 22 78 2a 22  tring match "x*"
0370: 20 24 74 61 67 5d 7d 20 7b 0a 09 20 20 20 20 73   $tag]} {..    s
0380: 65 74 20 3a 3a 54 41 47 20 5b 6c 69 6e 64 65 78  et ::TAG [lindex
0390: 20 24 74 61 67 20 30 5d 0a 09 20 20 20 20 62 6f   $tag 0]..    bo
03a0: 72 67 20 73 70 69 6e 6e 65 72 20 31 0a 09 20 20  rg spinner 1..  
03b0: 20 20 62 6f 72 67 20 61 63 74 69 76 69 74 79 20    borg activity 
03c0: 61 6e 64 72 6f 69 64 2e 6d 65 64 69 61 2e 61 63  android.media.ac
03d0: 74 69 6f 6e 2e 49 4d 41 47 45 5f 43 41 50 54 55  tion.IMAGE_CAPTU
03e0: 52 45 20 5c 0a 09 09 7b 7d 20 7b 7d 20 7b 7d 20  RE \...{} {} {} 
03f0: 7b 7d 20 7b 7d 20 69 6d 67 63 62 0a 09 20 20 20  {} {} imgcb..   
0400: 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a   break..}.    }.
0410: 7d 0a 0a 70 72 6f 63 20 63 75 62 65 20 7b 77 20  }..proc cube {w 
0420: 73 69 64 65 6c 65 6e 67 74 68 20 74 61 67 7d 20  sidelength tag} 
0430: 7b 0a 20 20 73 65 74 20 70 20 5b 65 78 70 72 20  {.  set p [expr 
0440: 24 73 69 64 65 6c 65 6e 67 74 68 20 2f 20 32 2e  $sidelength / 2.
0450: 30 5d 0a 20 20 73 65 74 20 6d 20 5b 65 78 70 72  0].  set m [expr
0460: 20 24 73 69 64 65 6c 65 6e 67 74 68 20 2f 20 2d   $sidelength / -
0470: 32 2e 30 5d 0a 0a 20 20 24 77 20 63 72 65 61 74  2.0]..  $w creat
0480: 65 20 70 6f 6c 79 67 6f 6e 20 5b 6c 69 73 74 20  e polygon [list 
0490: 24 70 20 24 70 20 24 70 20 20 24 6d 20 24 70 20  $p $p $p  $m $p 
04a0: 24 70 20 20 24 6d 20 24 6d 20 24 70 20 20 24 70  $p  $m $m $p  $p
04b0: 20 24 6d 20 24 70 5d 20 2d 74 61 67 73 20 78 31   $m $p] -tags x1
04c0: 0a 20 20 24 77 20 63 72 65 61 74 65 20 70 6f 6c  .  $w create pol
04d0: 79 67 6f 6e 20 5b 6c 69 73 74 20 24 70 20 24 70  ygon [list $p $p
04e0: 20 24 6d 20 20 24 6d 20 24 70 20 24 6d 20 20 24   $m  $m $p $m  $
04f0: 6d 20 24 6d 20 24 6d 20 20 24 70 20 24 6d 20 24  m $m $m  $p $m $
0500: 6d 5d 20 2d 74 61 67 73 20 78 32 0a 0a 20 20 24  m] -tags x2..  $
0510: 77 20 63 72 65 61 74 65 20 70 6f 6c 79 67 6f 6e  w create polygon
0520: 20 5b 6c 69 73 74 20 24 70 20 24 70 20 24 70 20   [list $p $p $p 
0530: 20 24 6d 20 24 70 20 24 70 20 20 24 6d 20 24 70   $m $p $p  $m $p
0540: 20 24 6d 20 20 24 70 20 24 70 20 24 6d 5d 20 2d   $m  $p $p $m] -
0550: 74 61 67 73 20 78 33 0a 20 20 24 77 20 63 72 65  tags x3.  $w cre
0560: 61 74 65 20 70 6f 6c 79 67 6f 6e 20 5b 6c 69 73  ate polygon [lis
0570: 74 20 24 70 20 24 6d 20 24 70 20 20 24 6d 20 24  t $p $m $p  $m $
0580: 6d 20 24 70 20 20 24 6d 20 24 6d 20 24 6d 20 20  m $p  $m $m $m  
0590: 24 70 20 24 6d 20 24 6d 5d 20 2d 74 61 67 73 20  $p $m $m] -tags 
05a0: 78 34 20 0a 0a 20 20 24 77 20 63 72 65 61 74 65  x4 ..  $w create
05b0: 20 70 6f 6c 79 67 6f 6e 20 5b 6c 69 73 74 20 24   polygon [list $
05c0: 70 20 24 70 20 24 70 20 20 24 70 20 24 6d 20 24  p $p $p  $p $m $
05d0: 70 20 20 24 70 20 24 6d 20 24 6d 20 20 24 70 20  p  $p $m $m  $p 
05e0: 24 70 20 24 6d 5d 20 2d 74 61 67 73 20 78 35 20  $p $m] -tags x5 
05f0: 0a 20 20 24 77 20 63 72 65 61 74 65 20 70 6f 6c  .  $w create pol
0600: 79 67 6f 6e 20 5b 6c 69 73 74 20 24 6d 20 24 70  ygon [list $m $p
0610: 20 24 70 20 20 24 6d 20 24 6d 20 24 70 20 20 24   $p  $m $m $p  $
0620: 6d 20 24 6d 20 24 6d 20 20 24 6d 20 24 70 20 24  m $m $m  $m $p $
0630: 6d 5d 20 2d 74 61 67 73 20 78 36 0a 7d 0a 0a 63  m] -tags x6.}..c
0640: 75 62 65 20 2e 77 31 20 31 2e 30 20 63 75 62 65  ube .w1 1.0 cube
0650: 5f 6f 6e 65 0a 2e 77 31 20 63 72 65 61 74 65 20  _one..w1 create 
0660: 6c 69 67 68 74 20 7b 30 2e 30 20 30 2e 30 20 33  light {0.0 0.0 3
0670: 2e 30 7d 0a 2e 77 31 20 74 72 61 6e 73 66 6f 72  .0}..w1 transfor
0680: 6d 20 2d 63 61 6d 65 72 61 20 6c 69 67 68 74 20  m -camera light 
0690: 7b 6c 6f 6f 6b 61 74 20 61 6c 6c 7d 0a 0a 23 20  {lookat all}..# 
06a0: 64 65 66 65 72 20 32 64 20 74 65 78 74 20 69 74  defer 2d text it
06b0: 65 6d 20 75 6e 74 69 6c 20 3c 43 6f 6e 66 69 67  em until <Config
06c0: 75 72 65 3e 20 6f 74 68 65 72 77 69 73 65 20 62  ure> otherwise b
06d0: 6f 6f 6d 21 20 6f 6e 20 73 6f 6d 65 20 64 65 76  oom! on some dev
06e0: 69 63 65 73 0a 62 69 6e 64 20 2e 77 31 20 3c 43  ices.bind .w1 <C
06f0: 6f 6e 66 69 67 75 72 65 3e 20 7b 0a 20 20 20 20  onfigure> {.    
0700: 2e 77 31 20 63 72 65 61 74 65 20 74 65 78 74 20  .w1 create text 
0710: 7b 30 20 30 7d 20 5c 0a 09 2d 74 65 78 74 20 22  {0 0} \..-text "
0720: 44 6f 75 62 6c 65 2d 74 61 70 20 6f 6e 20 66 61  Double-tap on fa
0730: 63 65 20 6f 66 20 63 75 62 65 20 74 6f 20 74 61  ce of cube to ta
0740: 6b 65 20 61 20 70 69 63 74 75 72 65 22 20 5c 0a  ke a picture" \.
0750: 09 2d 61 6e 63 68 6f 72 20 6e 77 20 2d 66 6f 6e  .-anchor nw -fon
0760: 74 20 7b 7b 44 65 6a 61 56 75 20 53 61 6e 73 7d  t {{DejaVu Sans}
0770: 20 38 7d 20 2d 74 61 67 73 20 74 78 74 0a 20 20   8} -tags txt.  
0780: 20 20 62 69 6e 64 20 2e 77 31 20 3c 43 6f 6e 66    bind .w1 <Conf
0790: 69 67 75 72 65 3e 20 7b 7d 0a 7d 0a 0a 70 72 6f  igure> {}.}..pro
07a0: 63 20 69 6d 67 63 62 20 7b 72 65 74 63 6f 64 65  c imgcb {retcode
07b0: 20 61 63 74 69 6f 6e 20 75 72 69 20 6d 69 6d 65   action uri mime
07c0: 74 79 70 65 20 63 61 74 65 67 6f 72 69 65 73 20  type categories 
07d0: 64 61 74 61 7d 20 7b 0a 20 20 20 20 69 66 20 7b  data} {.    if {
07e0: 24 72 65 74 63 6f 64 65 20 3d 3d 20 2d 31 7d 20  $retcode == -1} 
07f0: 7b 0a 09 23 20 53 55 43 43 45 53 53 0a 09 61 72  {..# SUCCESS..ar
0800: 72 61 79 20 73 65 74 20 72 65 73 75 6c 74 20 24  ray set result $
0810: 64 61 74 61 0a 09 69 66 20 7b 5b 69 6e 66 6f 20  data..if {[info 
0820: 65 78 69 73 74 73 20 72 65 73 75 6c 74 28 64 61  exists result(da
0830: 74 61 29 5d 7d 20 7b 0a 09 20 20 20 20 69 6d 61  ta)]} {..    ima
0840: 67 65 20 63 72 65 61 74 65 20 70 68 6f 74 6f 20  ge create photo 
0850: 70 31 20 2d 64 61 74 61 20 24 72 65 73 75 6c 74  p1 -data $result
0860: 28 64 61 74 61 29 0a 09 20 20 20 20 2e 77 31 20  (data)..    .w1 
0870: 69 74 65 6d 63 6f 6e 66 69 67 75 72 65 20 24 3a  itemconfigure $:
0880: 3a 54 41 47 20 2d 74 65 78 69 6d 61 67 65 20 7b  :TAG -teximage {
0890: 7d 20 2d 73 6d 6f 6f 74 68 20 31 0a 09 20 20 20  } -smooth 1..   
08a0: 20 2e 77 31 20 69 74 65 6d 63 6f 6e 66 69 67 75   .w1 itemconfigu
08b0: 72 65 20 24 3a 3a 54 41 47 20 2d 74 65 78 69 6d  re $::TAG -texim
08c0: 61 67 65 20 70 31 20 2d 73 6d 6f 6f 74 68 20 31  age p1 -smooth 1
08d0: 0a 09 20 20 20 20 69 6d 61 67 65 20 64 65 6c 65  ..    image dele
08e0: 74 65 20 70 31 0a 09 7d 0a 20 20 20 20 7d 0a 20  te p1..}.    }. 
08f0: 20 20 20 61 66 74 65 72 20 69 64 6c 65 20 7b 62     after idle {b
0900: 6f 72 67 20 73 70 69 6e 6e 65 72 20 30 7d 0a 7d  org spinner 0}.}
0910: 0a 0a                                            ..