###
# A basic canvas3d object
###
###
# topic: bb7c77db6e665ae5bb523b403a78522d
# description:
# Methods that the canvas expects to be implemented
# my the parent container
###
tao::class taotk::meta::canvas3d {
superclass taotk::meta::megawidget
variable selection {}
variable mode_stack {}
variable signals {}
variable modes {}
variable clearing 0
option sensitivity {
description {Mouse sensitity level (Higher=less sensitive)}
default 100
}
###
# topic: f8bf4ab1e9bf86c2169ee6288e49c3ba
###
method action::motor {
variable _motor_cmd
set start [clock milliseconds]
my move_camera $_motor_cmd
set end [clock milliseconds]
set delay [expr {25+$start-$end}]
if {$delay<=0} {
set delay idle
}
my event schedule motor $delay [namespace code {my action motor}]
}
###
# topic: f5db18aec012d226e67c86f1c5174c68
###
method action::position_light {
my canvas delete light
my canvas delete distantlight
my canvas create light [my canvas cget -cameralocation] -tags light -horizon 0
my canvas create light {0 0 100000} -tags distantlight -horizon 0 -diffuse {0.6 0.6 0.4}
my canvas create light {0 0 -100000} -tags distantlight -horizon 0 -diffuse {0.4 0.4 0.6}
#my canvas coords light [my canvas cget -cameralocation]
#my canvas transform -camera light {lookat all}
#my canvas transform -camera light {orbitup 50 orbitleft 30}
#foreach {cx cy cz} [my canvas cget -cameracenter] break
#foreach {lx ly lz} [my canvas cget -cameralocation] break
#set x [expr {100.0*($lx-$cx)}]
#set y [expr {100.0*($ly-$cy)}]
#set z [expr {100.0*($lz-$cz)}]
#my canvas coords light [list $x $y $z]
}
###
# topic: bc05d9f7d712d75b0cbd418c48e40d91
###
method action::reset_shot {
###
# Reset the camara
###
my canvas config -cameralocation {100 0 0} -cameraup {0 0 1}
my canvas transform -camera light {lookat all}
my canvas transform -camera light {orbitup 50 orbitleft 30}
my canvas config -cameraup {0 0 1} -enablealpha 1
my canvas config -saveunder none
my action position_light
}
###
# topic: 7b4aca87bf4fedb27137ad1f39d0f710
###
method binding_button_magic_eye {x y} {
}
###
# topic: fe4988df2075506eec876d0819c9c9ac
###
method binding_camera_fly_keypress key {
switch $key {
Escape {
my actionstack pop
}
}
}
###
# topic: 2706fcb9a3d2d384f360108bcc9c4a69
###
method binding_camera_fly_start {x y} {
my variable camerabot
array set camerabot {
speed 0
event {}
}
set camerabot(position) [my canvas cget -cameralocation]
set camerabot(orientation) [my canvas cget -cameraup]
variable _pan_x
variable _pan_y
set _pan_x $x
set _pan_y $y
}
###
# topic: b6743749c9165c5dd01ef45b2dbcebe9
###
method binding_camera_fly_step {x y} {
variable _pan_x
variable _pan_y
set dx [expr {$x-$_pan_x}]
set dy [expr {$y-$_pan_y}]
set _pan_x $x
set _pan_y $y
set msl [my cget sensitivity]
my move_camera [list panleft [expr {$dx * 180.0/(3.1415926 * $msl)}] panup [expr {$dy * 180.0/(3.1415926 * $msl)}]]
#my move_camera "move $dx $dy 0"
}
###
# topic: e9b99915b4506fd5c8ae152bcc07d0f6
###
method binding_camera_fly_wheel step {
if { $step > 0 } {
my move_camera [list movein [expr 1.001**$step]]
}
if { $step < 0 } {
my move_camera [list movein [expr 0.999**(-1.0*$step)]]
}
}
###
# topic: 6394ae56315d8eae96034d124c658c53
###
method binding_highlight_object_at {x y} {
return
#my variable highlight
set text {}
foreach item [my object_at $x $y] {
foreach {id ntag tags} $item break
if {[catch {[my nodeLayer $ntag] node_popup_text $ntag [string index $ntag 0] [string range $ntag 1 end]} text]} {
puts "Error [my nodeLayer $ntag] node_popup_text:\n$text"
}
}
my popup_display $text $x $y
}
###
# topic: 11c72a169b63ae02c94efd3fe4262e41
###
method binding_motion {x y} {
}
###
# topic: 2a17d5a6aa07c1c4a014c8d837dcf131
###
method binding_mouse_enter {} {
global g simconfig
variable _info
my event cancel popup
my reset_overlay
my put location {}
my put info {}
}
###
# topic: 755950de7bc97a29f1a74dd169a75ce4
###
method binding_mouse_leave {} {
global g simconfig
variable _info
my event cancel popup
my reset_overlay
my action clear_location
}
###
# topic: cc6c71bbecfc0ebfe22b1767c6b8ad23
###
method binding_orbit_start {x y} {
variable _pan_x
variable _pan_y
set _pan_x $x
set _pan_y $y
}
###
# topic: 4d81127928b0e1c3cd2e776c604912b4
###
method binding_orbit_step {x y} {
variable _pan_x
variable _pan_y
set dx [expr {$x-$_pan_x}]
set dy [expr {$y-$_pan_y}]
set _pan_x $x
set _pan_y $y
my move_camera "orbitleft $dx orbitup $dy"
}
###
# topic: 55df2c8d1a740019711436979a1f6cb1
###
method binding_orbit_wheel step {
if { $step > 0 } {
my move_camera [list movein [expr 1.001**$step]]
}
if { $step < 0 } {
my move_camera [list movein [expr 0.999**(-1.0*$step)]]
}
}
###
# topic: 305f7b920974e2fb7afca2209a25f2f8
###
method build_canvas w {
#set w [my organ hull]
ttk::frame $w.controls
ttk::frame $w.zoom
pack $w.controls -side top -fill x
pack $w.zoom -side bottom -fill x
set canvas $w.c
#canvas3d $canvas -width 600 -height 400 -bg #000 -enablealpha 1
canvas3d $canvas
$canvas configure -bg #000 -enablealpha 1
my graft canvas $canvas
###
# Generate a canvas for displaying popup info
###
#canvas $canvas.popup \
# -highlightthickness 1 -highlightbackground black \
# -bg #ff8 -bd 0
pack $canvas -side left -fill both -expand 1
my build_canvas_buttons $w.controls
###
# The master can call
# my timeControls later
###
my graft canvasframe $w
my graft popupframe $canvas.popup
}
###
# topic: c92f3ebf9eb7b24f439bf5cc751e8037
###
method build_canvas_buttons f {
set shellName [namespace which my]
set self $shellName
$shellName graft buttonbar $f
$shellName graft viewbar $f
if {[winfo exists $f]} {
destroy {*}[winfo children $f]
} else {
ttk::frame $f
}
ttk::button $f.norm -image icon:norm -command [list $shellName actionstack clear]
set_balloon $f.norm {Browse}
ttk::separator $f.sep
my controlButton $f.camera#orbit pan {
comment {Orbit Camera}
icon icon:pan
popups 0
cursor fleur
modal 1
main-script {
set canvas [%self% organ canvas]
%self% cancel_on_leave
bind $canvas <MouseWheel> [list %self% binding_orbit_wheel %D]
bind $canvas <ButtonPress-1> [list %self% binding_orbit_start %x %y]
bind $canvas <B1-Motion> [list %self% binding_orbit_step %x %y]
bind $canvas <KeyPress-Escape> [list %self% actionstack pop]
$button configure -command [list %self% actionstack pop]
%self% tree unselect
$button state pressed
}
exit-script {
$button state !pressed
$button configure -command [list %self% actionstack push pan]
}
}
ttk::separator $f.focus
pack \
$f.norm $f.camera#orbit $f.sep \
-side left -fill y -padx {0 0}
ttk::separator $f.rowsep
pack $f.rowsep -side top
###
# Add 3d controls
###
my motor_button $f Down {
command {orbitdown 2}
comment {Move the camera down while keeping it pointed at the target}
}
my motor_button $f Up {
command {orbitup 2}
comment {Move the camera upward while keeping it pointed at the target}
}
my motor_button $f Left {
command {orbitleft 2}
comment {Move the camera to the left while keeping it pointed at the target}
}
my motor_button $f Right {
command {orbitright 2}
comment {Move the camera to the right while keeping it pointed at the target}
}
my motor_button $f In {
command {movein 0.96}
comment {Move the camera inward toward target}
}
my motor_button $f Out {
command {movein 1.04}
comment {Pull the camera back away from the target}
}
my motor_button $f Fore {
command {move 200 0 0}
comment {Move the target point foreward on the ship}
}
my motor_button $f Aft {
command {move -200 0 0}
comment {Move the target point aftward on the ship}
}
my motor_button $f Stbd {
command {move 0 -200 0}
comment {Move the target point to starboard}
}
my motor_button $f Port {
command {move 0 200 0}
comment {Move the target point to port}
}
my motor_button $f Above {
command {move 0 0 200}
comment {Move the target point upward}
}
my motor_button $f Below {
command {move 0 0 -200}
comment {Move the target point downward}
}
my control_button $f Ship {
command {
set _tag {!hidden()}
%self% canvas transform -camera light [list looktoward $_tag]
%self% canvas config -cameraup {0 0 1}
%self% action position_light
}
comment {Move the target point that the camera is looking at to the center of the ship}
}
my control_button $f Selected {
command {
set _tag sel
%self% canvas config -cameracenter [lrange [my canvas boundingsphere sel] 1 end]
%self% action position_light
}
comment {Move the target point that the camera is looking at to the center of the currently selected objects}
}
my control_button $f Fit {
command {
set _tag {!hidden()}
%self% canvas transform -camera light [list lookat $_tag]
%self% canvas config -cameraup {0 0 1}
%self% action position_light
}
comment {Zoom the camera in or out so that either the whole ship or the currently selected object fulls the screen}
}
}
###
# topic: 4a449dc68655a237178dcd8f3f688dc4
###
method control_button {f name conf} {
set command {}
set icon {}
set comment {}
set tkconf {}
if {[dict exists $conf icon]} {
lappend tkconf -image [dict get $conf icon]
} elseif {[dict exists $conf label]} {
lappend tkconf -text [dict get $conf label]
} else {
lappend tkconf -text $name
}
dict with conf {}
set canvas [my organ canvas]
set self [namespace which my]
lappend map %self% $self my $self
lappend map %canvas% $canvas
set w [string tolower $name]
ttk::button $f.$w {*}$tkconf -command [string map $map $command]
pack $f.$w -side left
if {$comment!=""} {
set_balloon $f.$w $comment
}
}
###
# topic: 15c238c78b581222dcb2ce340ea17eb2
###
method default_canvas_bindings {} {
set canvas [my organ canvas]
foreach action [bind $canvas] {
if {$action=="<Configure>" || $action=="<Key-Tab>" || $action=="<FocusIn>"} continue
bind $canvas $action {}
}
bind $canvas <Motion> "[self] motion %x %y"
bind $canvas <Leave> "[self] leave"
}
###
# topic: a3347d2fc987af7eca9db20fe98a7843
###
method dump_visible {} {
foreach item [my canvas find all] {
if {[string is false [my canvas itemcget $item -hidden]]} {
puts [list $item [my canvas gettags $item]]
}
}
}
###
# topic: 4f207d9a3cceda802be7a638fe3a3b75
###
method highlight_selection_do {} {
my variable selection
#[self].structure repaint
my canvas dtag {withtag sel} sel
foreach item $selection {
set item [lindex [split $item -] 0]
set color [lindex [split $item -] 1]
if { $color eq {} } {
set color purple
}
[my nodeLayer $item] node_highlight $item $color
my canvas addtag sel withtag $item
}
my canvas transform -camera light [list lookat sel]
}
###
# topic: d216871ff1d52799ccdacac3d9126a17
###
method layer_update args {}
###
# topic: c470bbfb55f7bed8579a1e02285bec36
###
method leave {} {
}
###
# topic: 6ee245f749a227bfc06abf9712040e09
###
method motion {x y} {
}
###
# topic: eac60e866ad9c16bf86f0894a88f1e0a
###
method motor_button {f name conf} {
set command {}
set icon {}
set comment {}
set tkconf {}
if {[dict exists $conf icon]} {
lappend tkconf -image [dict get $conf icon]
} elseif {[dict exists $conf label]} {
lappend tkconf -text [dict get $conf label]
} else {
lappend tkconf -text $name
}
dict with conf {}
set w [string tolower $name]
ttk::button $f.$w {*}$tkconf
bind $f.$w <ButtonPress-1> [list [self] motor_start $command]
bind $f.$w <ButtonRelease-1> [list [self] motor_stop]
pack $f.$w -side left
if {$comment!=""} {
set_balloon $f.$w $comment
}
}
###
# topic: 8d5bb7d76cea8faabbc56265fb31525e
###
method motor_start command {
variable _motor_cmd
set _motor_cmd $command
my event schedule motor idle [namespace code {my action motor}]
}
###
# topic: 8eff4762a7309d268578958a9d1be1f3
###
method motor_stop {} {
my event cancel motor
my action position_light
}
###
# topic: 83d120b6e43c04d79771614235474fac
###
method move_camera xform {
my canvas transform -camera light $xform
foreach {cx cy cz} [my canvas cget -cameracenter] break
foreach {lx ly lz} [my canvas cget -cameralocation] break
set dx [expr {$lx-$cx}]
set dy [expr {$ly-$cy}]
set dz [expr {$lz-$cz}]
set dxy [expr {sqrt($dx*$dx + $dy*$dy)}]
set angle [expr {atan2($dz,$dxy)*180.0/3.1415926}]
if {$angle>80.0} {
my canvas transform -camera light [list orbitdown [expr {$angle-80.0}]]
} elseif {$angle<-80.0} {
my canvas transform -camera light [list orbitup [expr {-$angle-80.0}]]
}
my canvas config -cameraup {0 0 1}
my action position_light
}
###
# topic: 3e60b7ab842db023189137c99a5d735f
###
method object_at {x y} {
set x0 [expr {$x-2}]
set y0 [expr {$y-2}]
set x1 [expr {$x+2}]
set y1 [expr {$y+2}]
set r {}
global g simconfig
foreach id [my canvas find -sortbydepth viewport($x0,$y0,$x1,$y1)] {
set tags [my canvas gettags $id]
set ntag {}
set rtags {}
foreach tag $tags {
set type [string index $tag 0]
set id [string range $tag 1 end]
if { [string is integer $id] } {
if { $type ni {d s} && $ntag eq {} } {
set ntag $type$id
}
lappend rtags $type$id
#if { $type eq "k"} {
# set stag [expr {int([my canvas segment $id $x $y])}]
#}
}
}
lappend r [list $id $ntag $rtags $tags]
#puts [list $id $tags]
#if {[set i [lsearch -glob $tags {[a-z][0-9]*}]]>=0} {
# set tx [lindex $tags $i]
# set type [string index $tx 0]
# if {$type=="t" && !$g(selectable-bface)} continue
# if {$type=="k"} {
# set s [expr {int([my canvas segment $id $x $y])}]
# lappend r [list $id $tx $s]
# } else {
# lappend r [list $id $tx]
# }
#}
}
return $r
}
###
# topic: 1cd42887ee800b500d2e5b76d2782520
###
method scroll_to_selection {} {
set sel [my canvas boundingsphere sel]
if { $sel eq {} } {
my variable selection
set sel [my canvas boundingsphere [get selection]]
}
if { $sel eq {} } {
set sel {X 0.0 0.0 0.0}
}
my canvas config -cameracenter [lrange $sel 1 end]
}
###
# topic: 5e5addbb3db5be8cbc968cecbfb4d788
###
method Widget::create {} {
my build_canvas [my organ hull]
}
}
