
proc test_wb_looks {w} {
   global tool_dir2

   tdv_background $w #6688dd #ffffff

   tdv_logo $w [file join $tool_dir2 ANSYS_150.ppm]

   tdv_wb_binding $w
}


proc tdv_set_lighting {n w} {
   global tdv_lighting

   if {![winfo exist $w] || \
       ([winfo class $w] != "Tdv_Viewer")} {return ""}

   set v [$w get -light_$n]

   if {[info exist tdv_lighting($n)] && ($tdv_lighting($n) != $v)} {
      $w configure -light_$n $tdv_lighting($n)
      return $v
   } else {
      set tdv_lighting($n) $v
      return ""
   }
}

proc tdv_background_init {w {bgcolor ""} {bg1 ""}} {
    global tdv_background_color tdv_default
    global tdv_background_style

    if {$bgcolor == ""} {
       if {![info exist tdv_background_color] || ($tdv_background_color == "")} { return "" }
       if ![info exist tdv_background_style] {
           set tdv_background_style [lindex $tdv_background_color 0]
        }
        set bgcolor [lindex $tdv_background_color 1]
        if [lindex $tdv_background_color 0] {
            set bg1 [lindex $tdv_background_color 2]
        }
    }
    tdv_background $w $bgcolor $bg1
}

proc tdv_background {w {bgcolor ""} {bg1 ""}} {
    global tdv_background_color tdv_default
    global tdv_background_style
    
    if {$w == "reset"} {
	    if {$tdv_background_color == ""} return
	    set w $tdv_default
        if ![info exist tdv_background_style] {
           set tdv_background_style [lindex $tdv_background_color 0]
        }
	    set bgcolor [lindex $tdv_background_color 1]
	    set bg1 [lindex $tdv_background_color 2]
    }
    # this is needed because some images draw themselves differently depending on the bg color
    $w invalidate_caches display
    if {$bg1 == ""} {
	    $w configure -background $bgcolor -use_grad_bg 0
    } else {
	    if [catch { set tt [from_tkcolor_get rgb_bytes $bgcolor] } em] {
	        mess "Error in from_tkcolor_get rgb_bytes $bgcolor: $em\n" red
	        return ""
	    }
	    if [catch { set bb [from_tkcolor_get rgb_bytes $bg1] } em] {
	        mess "Error in from_tkcolor_get rgb_bytes $bg1: $em\n" red
	        return ""
	    }
	    set n 0
	    foreach t $tt b $bb {
	        if {abs($t - $b) > 5} { set n 1 }
	    }
	    if ![info exist tdv_background_style] {
	        set tdv_background_style $n
	    } elseif {$n == 0} {
	        set tdv_background_style 0
	    }
        $w configure -background $bgcolor -bmbgcolor $bg1 -use_grad_bg $tdv_background_style
	    $w redraw
    }
    # This gets saved in the settings file
    set tdv_background_color [list [$w cget -use_grad_bg] [$w cget -background] [$w cget -bmbgcolor]]
}

proc tdv_logo_background {{w ""}} {
    global tdv_default tdv_background_color

    if {$w == ""} { set w $tdv_default }

    if {[info command tdv_blendpixmap_im] == ""} { return 0 }

    if ![info exist tdv_background_color] {
        return 0
    }
	set bgcolor1 [lindex $tdv_background_color 1]
	set bgcolor2 [lindex $tdv_background_color 2]
	if [catch { set tt1 [from_tkcolor_get rgb_bytes $bgcolor1] } em] {
	    return 0
	}
	if [catch { set tt2 [from_tkcolor_get rgb_bytes $bgcolor2] } em] {
	    return 0
	}
	set n 1
	foreach t1 $tt1 t2 $tt2 {
        if {[expr abs($t1)] != 255} { set n 0; break }
        #if {[expr abs($t2)] != 255} { set n 0; break }
	}
	return $n
}

proc tdv_logo {w path {pos ""}} {
    global tdv_logo tool_dir2 env common_tool_dir

    if {[info command tdv_blendpixmap_im] == ""} { return "" }
    set n [tdv_logo_background $w]
    if {$pos == ""} {
        if [info exist env(ICEM_ACADEMIC)] {
            if $n {
                set path2 [file join $tool_dir2 ANSYS_academic_large_black.ppm]
            } else {
                set path2 [file join $tool_dir2 ANSYS_academic_large_white.ppm]
            }
        } else {
            if $n {
                set path2 [file join $tool_dir2 ANSYS_large_black.ppm]
            } else {
                set path2 [file join $tool_dir2 ANSYS_large_white.ppm]
            }
        }
        if ![catch {set fp [open [file rootname $path2].pos]}] {
            set pos [gets $fp]
            close $fp
        }
        if {$pos == ""} {
            if [info exist env(ICEM_ACADEMIC)] {
                set pos "-140 100 0"
            } else {
                set pos "-140 80 0"
            }
        }
    }
    if [info exist tdv_logo($w)] {
        $tdv_logo($w) configure -pos $pos
    } else {
        set tdv_logo($w) [tdv_blendpixmap_im -pos $pos]
        $w add_image $tdv_logo($w)
    }
    $tdv_logo($w) read $path
    if $n {
        $tdv_logo($w) set_alpha transparent_col 255
    } else {
        $tdv_logo($w) set_alpha density
    }
}

proc tdv_logo_delete {w} {
   global tdv_logo
   
   if {[info command tdv_blendpixmap_im] == ""} { return "" }
   if [info exist tdv_logo($w)] {
      $tdv_logo($w) delete
      unset tdv_logo($w)
   }
}

proc tdv_wb_binding {w} {
   global tdv_wb_axes tdv_axes tdv_wb_circle
   global tdv_binding

   if ![info exist tdv_wb_axes($w,active_on)] {
      tdv_wb_axes_toggle $w
   }
   if ![info exist tdv_wb_circle($w,on)] {
     tdv_wb_circle_toggle $w
   }
}

proc tdv_wb_circle_toggle {w {ent <ButtonPress-1>}} {
   global tdv_wb_circle
   
   if ![info exist tdv_wb_circle($w)] {
 #    set tdv_wb_circle($w) \
 #         [tdv_wbcircle_im -transform 0 -color #666666 -box_size 28]
      set tdv_wb_circle($w) \
           [tdv_wbcircle_im -transform 0 -box_size 32 -control_style 1]
   }

   if ![info exist tdv_wb_circle($w,on)] {
      $w add_image $tdv_wb_circle($w)
      set tdv_wb_circle($w,on) $ent
   }  else {
      $w remove_image $tdv_wb_circle($w)
      unset tdv_wb_circle($w,on)
   } 
}


proc tdv_wb_axes_toggle {w} {
   global tdv_wb_axes tdv_axes

   if [info exist tdv_wb_axes($w,active_on)] {
      unset tdv_wb_axes($w,active_on)
   } else {
      set tdv_wb_axes($w,active_on) ""
      if [info exist tdv_axes($w)] {
         set tdv_wb_axes($w) $tdv_axes($w)
         $tdv_wb_axes($w) configure -style 1 -to_xp -80 -to_yp -70 -size 60
      } else {
         set tdv_wb_axes($w) [tdv_axes_im -transform 0 -y_dir_up 1 -style 1 -to_xp -80 -to_yp -70 -size 60]
         $w add_image $tdv_wb_axes($w)
      }
   } 
}


array set tdv_wb_axes {
   cur_to+x        wb_to+x
   cur_to-x        wb_to-x
   cur_to+y        wb_to+y
   cur_to-y        wb_to-y
   cur_to+z        wb_to+z
   cur_to-z        wb_to-z
   cur_toiso       wb_toiso
   to-x    "0 -0.70710678118655 0 0.70710678118655"
   to+x    "0  0.70710678118655 0 0.70710678118655"
   to-y    "0.70710678118655 0 0 0.70710678118655"
   to+y    "0 0.70710678118655 0.70710678118655 0"
   to-z    "0 1 0 0"
   to+z    "0 0 0 1"
   toiso   "-0.353553385857 0.353553385856 0.14644660467 0.85355339533" 
}

array set tdv_wb_circle {
   cur_rot        wb_rot
   cur_pitch      wb_pitch
   cur_yaw        wb_yaw
   cur_roll       wb_roll
}

array set tdv_wb_cursor {
   dir ""
   wb_rot     Rotate.cur
   wb_pitch   Pitch.cur
   wb_yaw     Yaw.cur
   wb_roll    Roll.cur
   wb_to+x    +X.cur
   wb_to-x    -X.cur
   wb_to+y    +Y.cur
   wb_to-y    -Y.cur
   wb_to+z    +Z.cur
   wb_to-z    -Z.cur
   wb_toiso   Iso.cur
}

proc tdv_set_mouse_motion_binding {w ent {b ""} {what ""}} {
  global tdv_binding

   set tdv_binding($w,$ent) $what
   set tdv_binding($w,$ent,saved) $what
   set tdv_binding($w,$ent,b) $b

   bind $w $ent "tdv_mouse_butmotion $w $ent %x %y"
}

proc tdv_mouse_butmotion {w ent x y} {
   global tdv_wb_axes

   if [info exist tdv_wb_axes($w,spin_to)] {return ""}

   global tdv_zoomin_box_loc
   if [info exist tdv_zoomin_box_loc($w)] {
      tdv_zoomin_mv $w $x $y
   } else {
      tdv_doit_op $w $x $y
   }
}

proc tdv_zoomin_begin {w b x y} {
    global tdv_waiting_for_click tdv_waiting_for_motion
    global tdv_zoomin_box_loc tdv_zoomin_box

    # Somebody might hold down the z key while zooming and cause auto-repeat.
    # If so ignore the command.
    if {[info exists tdv_waiting_for_click($w)] || \
            [info exists tdv_waiting_for_motion($w)]} return ""

    tdv_cur $w zoomin

    set tdv_zoomin_box_loc($w) [list "$x $y" "$x $y"]

    return ""
}

proc tdv_zoomin_mv {w x y} {
   global tdv_zoomin_box_loc tdv_zoomin_box

   if {![info exist tdv_zoomin_box_loc($w)] || \
               ($tdv_zoomin_box_loc($w) == "")} {
      set x0 $x
      set y0 $y
   } else {
      set p1 [lindex $tdv_zoomin_box_loc($w) 0]
      set x0 [lindex $p1 0]
      set y0 [lindex $p1 1]
   }
   if {($x0 == "") || ($y0 == "")} {return ""}

   if ![info exist tdv_zoomin_box($w)] {
      set tdv_zoomin_box($w) [tdv_rubbox_im -color orange -transform 0 \
                                  -x1 $x0 -y1 $y0 -x2 $x -y2 $y]
      $w add_image $tdv_zoomin_box($w)
      global tdv_rubbox_overlay
      set n $tdv_rubbox_overlay
      if [$w cget -use_grad_bg] {set n 0} 
      $tdv_zoomin_box($w) configure -overlay $n
   } else {
      $tdv_zoomin_box($w) configure -x1 $x0 -y1 $y0 -x2 $x -y2 $y
   }

   set tdv_zoomin_box_loc($w) [list "$x0 $y0" "$x $y"]
}

proc tdv_zoomin_end {w} {
   global tdv_zoomin_box_loc tdv_zoomin_box

   if [info exist tdv_zoomin_box($w)] {
      $tdv_zoomin_box($w) delete
      unset tdv_zoomin_box($w)
   } 

   tdv_zoomin_do $w

   if [info exist tdv_zoomin_box_loc($w)] {
      unset tdv_zoomin_box_loc($w)
   }
}

proc tdv_set_mouse_release_binding {w ent {b ""} {what ""}} {
   global tdv_binding

   set tdv_binding($w,$ent) $what
   set tdv_binding($w,$ent,saved) $what
   set tdv_binding($w,$ent,b) $b

   bind $w $ent "tdv_mouse_butrelease $w $ent %x %y"
}

proc tdv_mouse_butrelease {w ent x y} {
   global tdv_wb_axes tdv_binding tdv_x tdv_y
   global tdv_scale tdv_pos tdv_center tdv_zoomin_box
   global tdv_select_restore tdv_select_loc
   global tdv_mouse_bindings

   if [info exist tdv_wb_axes($w,spin_to)] {
      if ![info exist tdv_wb_axes($w,vptranslist)] {
         set tdv_wb_axes($w,vptranslist) [vptranslist -viewer $w]
      }
      $tdv_wb_axes($w,vptranslist) app_current
    # $tdv_wb_axes($w,vptranslist) app_transf "1 1 1" \
    #          $tdv_scale($w) $tdv_pos($w) $tdv_center($w) \
    #          $tdv_wb_axes($w,spin_to)
      $tdv_wb_axes($w,vptranslist) app_transf "1 1 1" \
               $tdv_scale($w) "0 0 0" [tdv_get_centroid $w] \
               $tdv_wb_axes($w,spin_to)

      if [info exist tdv_wb_axes($w,animate_steps)] {
         set steps $tdv_wb_axes($w,animate_steps)
      } else {
         set steps 10
      }
      set dt [expr 1.0/$steps]
      for {set i 1} {$i < $steps} {incr i} {
         $tdv_wb_axes($w,vptranslist) animate [expr $i * $dt]
         $w redraw
         after 50 
      }
      set rr [$tdv_wb_axes($w,vptranslist) animate 1.0]
      $w redraw
      foreach {n i} {scale 1 pos 2 center 3 rot 4} {
         global tdv_$n; set tdv_${n}($w) [lindex $rr $i]
      }

      $tdv_wb_axes($w,vptranslist) del_transf 0
      $tdv_wb_axes($w,vptranslist) del_transf 0
      unset tdv_wb_axes($w,spin_to)
      # to avoid that the mouse buttons 1-3 loose their standart bindings
      if [info exists tdv_mouse_bindings(<ButtonPress-1>)] {
          set tdv_binding($w,<ButtonPress-1>) $tdv_mouse_bindings(<ButtonPress-1>)
      }
      if [info exists tdv_mouse_bindings(<ButtonPress-2>)] {
          set tdv_binding($w,<ButtonPress-2>) $tdv_mouse_bindings(<ButtonPress-2>)
      }
      if [info exists tdv_mouse_bindings(<ButtonPress-3>)] {
          set tdv_binding($w,<ButtonPress-3>) $tdv_mouse_bindings(<ButtonPress-3>)
      }
   } elseif [info exist tdv_zoomin_box($w)] {
      tdv_zoomin_end $w
   } elseif [info exist tdv_select_restore($w)] {
      set e1 [lindex $tdv_select_restore($w) 0]
      set b1 [lindex $tdv_select_restore($w) 1]
      set k1 [lindex $tdv_select_restore($w) 2]

      tdv_set_mouse_press_binding $w $e1 $b1 $k1

      unset tdv_select_restore($w)
   } else {
      tdv_end_op $w
   }
   catch {unset tdv_binding($w,doing)}
}


proc tdv_set_mouse_press_binding {w ent b what} {
   global tdv_binding tdv_wb_circle

   if {[info exist tdv_wb_circle($w)] && ($b == 1)} {
      if {[info exist tdv_wb_circle($w,on)] && ($tdv_wb_circle($w,on) == $ent)} {
         if {$what != "rot"} { tdv_wb_circle_toggle $w }
      } elseif {$what == "rot"} {
         tdv_wb_circle_toggle $w 
      }
   }

   if {$what == "select_loc"} {
      global tdv_select_restore
      if [info exist tdv_select_restore($w)] { return 0 }

      set bn ""
      if [info exist tdv_binding($w,$ent,b)] {set bn $tdv_binding($w,$ent,b)}
      set et ""
      if [info exist tdv_binding($w,$ent)] {set et $tdv_binding($w,$ent)}

      set tdv_select_restore($w) [list $ent $bn $et]
   }

   set tdv_binding($w,$ent) $what
   set tdv_binding($w,$ent,saved) $what
   set tdv_binding($w,$ent,b) $b

   bind $w $ent "tdv_mouse_butpress $w $ent %x %y"

   return 1
}

proc tdv_mouse_butpress {w ent x y} {
   global tdv_binding
   global tdv_rotaxis tdv_rotaxis_center
   if [info exist tdv_binding($w,doing)] {return ""}
   
   if {![info exist tdv_binding($w,$ent)] || ($tdv_binding($w,$ent) == "")} {
      mess "Warning: no binding for $ent in $w\n" blue
      return ""
   } 

   set b $tdv_binding($w,$ent,b)
   set what $tdv_binding($w,$ent)
   switch -glob -- $what {
      to* {
         global tdv_wb_axes
         set tdv_wb_axes($w,spin_to) $tdv_wb_axes($what)
      }
      wb_rot {
         tdv_begin_op $w $b $x $y $what 0
      }
      wb_yaw {
         set tdv_rotaxis_center($w) [tdv_get_centroid $w]
         set tdv_rotaxis($w) [$w getscreenaxis 1]

         tdv_begin_op $w $b $x $y $what 0
      }
      wb_pitch {
         set tdv_rotaxis_center($w) [tdv_get_centroid $w]
         set tdv_rotaxis($w) [$w getscreenaxis 0]

         tdv_begin_op $w $b $x $y $what 0
      }
      wb_roll {
         set tdv_rotaxis_center($w) [tdv_get_centroid $w]
         set tdv_rotaxis($w) [$w getscreenaxis 2]

         tdv_begin_op $w $b $x $y $what 0
      }
      zoomin {
         tdv_zoomin_begin $w $b $x $y
      }
      select_loc {
         global tdv_select_loc
         set tdv_select_loc($w) "$b $x $y"
      }
      default {
         tdv_begin_op $w $b $x $y $what
      }
   }
   set tdv_binding($w,doing) [list $ent $what]
}


proc tdv_track_wb_mouse {w x y} {
   global tdv_wb_axes tdv_wb_circle
   global tdv_binding

   if [info exist tdv_wb_axes($w)] {
      if [info exist tdv_wb_axes($w,spin_to)] { return "" }

   # Error when tdv_wb_axes($w,active_on) unset in tdv_wb_axes_toggle
   # 
	if ![info exist tdv_wb_axes($w,active_on)] { return "" }
   
      set which [$tdv_wb_axes($w) is_active_on $x $y]
      if {$tdv_wb_axes($w,active_on) != $which} {
         set tdv_wb_axes($w,active_on) $which
         $w redraw
      }
      if {$which != ""} {
   #      set_cursor $w $tdv_wb_axes(cur_to$which)
          tdv_set_wb_cursor $w $tdv_wb_axes(cur_to$which)

          foreach ent {<ButtonPress-1> <ButtonPress-2> <ButtonPress-3>} {
             set tdv_binding($w,$ent) to$which
          }
          return to$which
      }
   }
   if [info exist tdv_wb_circle($w,on)] {
      set where [$tdv_wb_circle($w) is_active_on $x $y]
      if {$where == ""} {return ""}
    
      set ent $tdv_wb_circle($w,on)
      if {$tdv_binding($w,$ent) != "wb_$where"} {
   #     set_cursor $w $tdv_wb_circle(cur_$where)
         tdv_set_wb_cursor $w $tdv_wb_circle(cur_$where)

         set tdv_binding($w,$ent) wb_$where
      }
      foreach e {<ButtonPress-1> <ButtonPress-2> <ButtonPress-3>} {
         if {$e != $ent} { set tdv_binding($w,$e) $tdv_binding($w,$e,saved) }
      }
      return $tdv_binding($w,$ent)
   } else {
      foreach e {<ButtonPress-1> <ButtonPress-2> <ButtonPress-3>} {
         if {![info exist tdv_binding($w,$e)]} {continue}
         if {$tdv_binding($w,$e) != $tdv_binding($w,$e,saved)} {
            set tdv_binding($w,$e) $tdv_binding($w,$e,saved)
            tdv_cur $w dynamics
         }
      }
      return ""
   }
}

proc tdv_wb_roll {w x y} {
   global tdv_wb_circle tdv_rot tdv_rotaxis_sncs tdv_x tdv_y

   if [tdv_wb_skip $w] { return }

   set incr [$tdv_wb_circle($w) roll $tdv_x($w) $tdv_y($w) $x $y]

 #  set nrot [tdv_qcomp $tdv_rot($w) $incr]
 #  if {$nrot == "0 0 0 0"} return
 #  set tdv_rot($w) $nrot

   set tdv_rotaxis_sncs($w) [list [lindex $incr 3] [lindex $incr 2]]
   tdv_wb_axisrot $w $x $y
}

proc tdv_wb_pitch {w x y} {
   global tdv_wb_circle tdv_rot tdv_rotaxis_sncs tdv_x tdv_y

   if [tdv_wb_skip $w] { return }

   set incr [$tdv_wb_circle($w) pitch $y $tdv_y($w)]

 #  set nrot [tdv_qcomp $tdv_rot($w) $incr]
 #  if {$nrot == "0 0 0 0"} return
 #  set tdv_rot($w) $nrot

   set tdv_rotaxis_sncs($w) [list [lindex $incr 3] [lindex $incr 0]]
   tdv_wb_axisrot $w $x $y
}

proc tdv_wb_yaw {w x y} {
   global tdv_wb_circle tdv_rot tdv_rotaxis_sncs tdv_x tdv_y

   if [tdv_wb_skip $w] { return }

   set incr [$tdv_wb_circle($w) yaw $x $tdv_x($w)]

 #  set nrot [tdv_qcomp $tdv_rot($w) $incr]
 #  if {$nrot == "0 0 0 0"} return
 #  set tdv_rot($w) $nrot

   set tdv_rotaxis_sncs($w) \
            [list [lindex $incr 3] [expr - [lindex $incr 1]]]
   tdv_wb_axisrot $w $x $y
}


proc tdv_wb_skip {w} {
   global tdv_scale_backwards tdv_mouse_bindings
   global tdv_temporary_dynamics_cursor tdv_waiting_for_motion
   global tdv_click_function tdv_dynamics tdv_x tdv_y
   global tdv_wb_circle tdv_rot tdv_center

   set backw [expr {([info exists tdv_scale_backwards] || \
                    ($tdv_mouse_bindings(scale_dir) < 0))} ? -1 : 1]

   if ![info exists tdv_temporary_dynamics_cursor($w)] {
      if [info exists tdv_waiting_for_motion($w)] {
         set tdv_waiting_for_motion($w) "$x $y"
         return 1
      }
      if [info exists tdv_click_function($w,3)] {return 1}
   }
   if {![info exists tdv_dynamics($w)] || ![info exists tdv_x($w)]} {return 1}

   if ![info exist tdv_wb_circle($w)] {return 1}

   return 0
}

proc tdv_wb_axisrot {w x y} {
   global tdv_rotaxis tdv_rotaxis_sncs tdv_rotaxis_center
   global tdv_rot tdv_center tdv_x tdv_y

   if {![info exist tdv_rotaxis($w)] || \
       ![info exist tdv_rotaxis_sncs($w)] || \
       ![info exist tdv_rotaxis_center($w)]} { return }

   set sn [lindex $tdv_rotaxis_sncs($w) 1]
   if {($sn < 1.0e-20) && ($sn > -1.0e-20)} {return}

   set rx [expr [lindex $tdv_rotaxis($w) 0] * $sn]
   set ry [expr [lindex $tdv_rotaxis($w) 1] * $sn]
   set rz [expr [lindex $tdv_rotaxis($w) 2] * $sn]

   set cs [lindex $tdv_rotaxis_sncs($w) 0]
   set rr [eval $w get_rot_about_line $rx $ry $rz $cs $tdv_rotaxis_center($w)]
   if {$rr == ""} {return}

   set tdv_rot($w) [lindex $rr 0]
   set tdv_center($w) [lindex $rr 1]

   set tdv_x($w) $x
   set tdv_y($w) $y

   tdv_trans_update $w
}



proc tdv_set_wb_cursor {w spec} {
   global is_win tdv_wb_cursor

   if $is_win {
      if {$tdv_wb_cursor(dir) == ""} {
         global tool_dir2
         set dir [file join $tool_dir2 wb_cursors]
         if {[string first " " $dir] >= 0} {
            set dir [join [split $dir " "] "\\ "]
         }
         set tdv_wb_cursor(dir) $dir   
      }
      if [info exist tdv_wb_cursor($spec)] {
       # set ff [file join $tdv_wb_cursor(dir) $tdv_wb_cursor($spec)]
       # if {[string first " " $ff] >= 0} {
       #    set ff [join [split $ff " "] "\\ "]
       # }
         $w configure -cursor @$tdv_wb_cursor(dir)/$tdv_wb_cursor($spec)
      }
   } else {
      tdv_cur $w $spec 0 #ab5811
   }
}
