Artifact Content
Not logged in

Artifact d0f68f21fb0e44bbe3f0a2ea60fec938efb8aac6:


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