#! /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}
}