# Tk stuff to draw a 3-D wireframe virtual sphere and
# allow the user to drag it around.

source unit-sphere

proc vsphere {canv tag x0 y0 x1 y1} {
    global lastcirc spherecanv spherevport
    set v [$canv create viewport $x0 $y0 $x1 $y1]
    set vp $canv-$v
    set spherecanv($tag) $canv
    set spherevport($tag) $v
    foreach x [unitsphere $canv] {
        $canv addtag $tag withtag $x
    }
    $canv itemconf $tag -view $v -fill white -width 0
    $canv itemconf $v -view {.2 1 .3} -up {0 0 1} -dist 8 -zmax 8 -angle 20 \
		-perspective false

#   draw a surrounding circle
    set cent [$vp proj {0 0 0}]
    set xc [lindex $cent 0]
    set yc [lindex $cent 1]
    set xl [lindex [$vp proj [$vp sphere -100 $yc]] 0]
    set xr [lindex [$vp proj [$vp sphere 2000 $yc]] 0]
    set lastcirc($tag) [$canv create oval $xl [expr $yc-$xc+$xl] \
		$xr [expr $yc-$xc+$xr] -width 1 -outline white]

    labelaxes $canv $v

    $canv raise $v
    $canv bind $v <1> "grabsphere $canv $v %x %y"
    $canv bind $v <B1-Motion> "rotsphere $canv $v %x %y"
}

proc circ {tag a b} {
    global lastcirc spherecanv
    set canv $spherecanv($tag)
    $canv del $lastcirc($tag)
    set lastcirc($tag) [$canv create oval $a $a $b $b -width 1 -outline cyan]
}

proc grabsphere {canv v x y} {
    global sphere_point
    set sphere_point($canv) [$canv-$v sphere $x $y]
}

proc rotsphere {canv v x y} {
    global sphere_point
    set newpoint [$canv-$v sphere $x $y]
    set new [$canv-$v roll $sphere_point($canv) $newpoint]
    eval "$canv itemc $v $new"
    showaxes $canv $v
}

proc labelaxes {canv v} {
    global xposn yposn labelpos labelitems
    set labellist {{{1 0 0} +X} {{-1 0 0} -X} {{0 1 0} +Y}
		   {{0 -1 0} -Y} {{0 0 1} +Z} {{0 0 -1} -Z}}
    set items {}
    foreach x $labellist {
	set pos [lindex $x 0]
	set name [lindex $x 1]
	set item [$canv create text -100 -100 -text $name -fill green]
	set xposn($canv-$item) -100
	set yposn($canv-$item) -100
	set labelpos($canv-$item) $pos
	lappend items $item
    }
    set labelitems($canv-$v) $items
    showaxes $canv $v
}

proc showaxes {canv v} {
    global xposn yposn labelpos labelitems
    set maxdepth [lindex [$canv itemc $v -zmax] 4]
    foreach item $labelitems($canv-$v) {
	set pos [$canv-$v project $labelpos($canv-$item)]
	if {$maxdepth > 0 && [lindex $pos 2] > $maxdepth} {
	    # make the label invisible
	    set x -100
	    set y -100
	} else {
	    set x [lindex $pos 0]
	    set y [lindex $pos 1]
	}
	$canv move $item [expr $x-$xposn($canv-$item)] \
		[expr $y-$yposn($canv-$item)]
	set xposn($canv-$item) $x
	set yposn($canv-$item) $y
    }
}

proc getview {tag} {
    global spherecanv spherevport
    set canv $spherecanv($tag)
    set v $spherevport($tag)
    list [lindex [$canv itemconf $v -view] 4] \
	 [lindex [$canv itemconf $v -up] 4]
}

canvas .c -width 150 -height 150 -bg black
pack append . .c top
vsphere .c sphere 0 0 150 150
