Check-in [5735e8d93e]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:added another 3d canvas demo script
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 5735e8d93e7202285c2ae44f7eb9644ee48fede4
User & Date: chw 2014-12-13 17:51:20.700
Context
2014-12-16
03:19
updated mentry, tablelist, wcb to latest upstream versions check-in: 9f0000c7a4 user: chw tags: trunk
2014-12-13
17:51
added another 3d canvas demo script check-in: 5735e8d93e user: chw tags: trunk
17:50
changed glshim log output to use __android_log_print check-in: 516beacc4c user: chw tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Added assets/Canvas3d1.2.1/demo/photocube.tcl.
























































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
#! /bin/sh
# The next line restarts using tclsh \
exec tclsh "$0" ${1+"$@"}

package require Tk
package require Img
package require Canvas3d

wm attributes . -fullscreen 1
canvas3d .w1
pack .w1 -expand yes -fill both -side left
.w1 configure -width 300 -height 300 -background black

bind all <Break> exit

# Camera control
proc T {w args} {
    $w transform -camera type(light) $args
    $w delete CameraString
}

# Mouse control
bind .w1 <B1-Motion> {
    set ry [expr 360.0 * (%y  - $::Y) / [%W cget -height]]
    set rx [expr 360.0 * (%x  - $::X) / [%W cget -width]]
    T %W orbitup $ry orbitleft $rx
    set ::X %x
    set ::Y %y
}
bind .w1 <1> {
    set ::X %x
    set ::Y %y
}

bind .w1 <Double-1> {
    .w1 delete txt
    imgfetch %W %x %y
}

proc imgfetch {w x y} {
    foreach id [$w find -sortbydepth viewport($x,$y)] {
	set tag [$w gettag $id]
	if {[string match "x*" $tag]} {
	    set ::TAG [lindex $tag 0]
	    borg spinner 1
	    borg activity android.media.action.IMAGE_CAPTURE \
		{} {} {} {} {} imgcb
	    break
	}
    }
}

proc cube {w sidelength tag} {
  set p [expr $sidelength / 2.0]
  set m [expr $sidelength / -2.0]

  $w create polygon [list $p $p $p  $m $p $p  $m $m $p  $p $m $p] -tags x1
  $w create polygon [list $p $p $m  $m $p $m  $m $m $m  $p $m $m] -tags x2

  $w create polygon [list $p $p $p  $m $p $p  $m $p $m  $p $p $m] -tags x3
  $w create polygon [list $p $m $p  $m $m $p  $m $m $m  $p $m $m] -tags x4 

  $w create polygon [list $p $p $p  $p $m $p  $p $m $m  $p $p $m] -tags x5 
  $w create polygon [list $m $p $p  $m $m $p  $m $m $m  $m $p $m] -tags x6
}

cube .w1 1.0 cube_one
.w1 create light {0.0 0.0 3.0}
.w1 transform -camera light {lookat all}

# defer 2d text item until <Configure> otherwise boom! on some devices
bind .w1 <Configure> {
    .w1 create text {0 0} \
	-text "Double-tap on face of cube to take a picture" \
	-anchor nw -font {{DejaVu Sans} 8} -tags txt
    bind .w1 <Configure> {}
}

proc imgcb {retcode action uri mimetype categories data} {
    if {$retcode == -1} {
	# SUCCESS
	array set result $data
	if {[info exists result(data)]} {
	    image create photo p1 -data $result(data)
	    .w1 itemconfigure $::TAG -teximage {} -smooth 1
	    .w1 itemconfigure $::TAG -teximage p1 -smooth 1
	    image delete p1
	}
    }
    after idle {borg spinner 0}
}