#
# Copyright 2006 (c) Pointwise, Inc.
# All rights reserved.
# 
# This sample Gridgen script is not supported by Pointwise, Inc.
# It is provided freely for demonstration purposes only.  
# SEE THE WARRANTY DISCLAIMER AT THE BOTTOM OF THIS FILE.
#
# Rotate the view so that the viewer is looking down a specified view vector
#
catch {
  set scriptDir [file dirname [info script]]
  source [file join $scriptDir pwiLogo.glf]
}

proc matrixToQuat { matName } {
  upvar $matName mat
  set tr [expr {$mat(0,0) + $mat(1,1) + $mat(2,2)}]
  if {$tr > 0.0} {
    set s [expr {sqrt(1.0 + $tr)}]
    set qw [expr {$s * 0.5}]
    set s [expr {0.5 / $s}]
    set v(0) [expr {($mat(2,1) - $mat(1,2)) * $s}]
    set v(1) [expr {($mat(0,2) - $mat(2,0)) * $s}]
    set v(2) [expr {($mat(1,0) - $mat(0,1)) * $s}]
  } else {
    set i 0
    if {$mat(1,1) > $mat(0,0)} {
      set i 1
    }
    if {$mat(2,2) > $mat($i,$i)} {
      set i 2
    }
    set j [expr {($i + 1) % 3}]
    set k [expr {($j + 1) % 3}]
    set s [expr {sqrt(($mat($i,$i)-($mat($j,$j)+$mat($k,$k)))+1.0)}]
    set v($i) [expr {$s * 0.5}]
    if {abs($s) < 1.0e-8} {
      set qw 1.0
      set v(0) 1.0
      set v(1) 0.0
      set v(2) 0.0
    } else {
      set s [expr {0.5 / $s}]
      set qw [expr {($mat($k,$j) - $mat($j,$k)) * $s}]
      set v($j) [expr {($mat($j,$i) + $mat($i,$j)) * $s}]
      set v($k) [expr {($mat($k,$i) + $mat($i,$k)) * $s}]
    }
  }
  set qx $v(0)
  set qy $v(1)
  set qz $v(2)
  return [list $qx $qy $qz $qw]
}

proc quatNormalize { q } {
  foreach {qx qy qz qw} $q {break}
  set mag [expr {$qx * $qx + $qy * $qy + $qz * $qz + $qw * $qw}]
  if {0.0 < $mag && 1.0 != $mag} {
    set mag [expr {1.0 / sqrt($mag)}]
    set qx [expr {$qx * $mag}]
    set qy [expr {$qy * $mag}]
    set qz [expr {$qz * $mag}]
    set qw [expr {$qw * $mag}]
  }
  return [list $qx $qy $qz $qw]
}

#
# Based on Jack Morrison's "Quaternion Interpolation with Extra Spin"
# from Graphics Gem III (http://www.graphicsgems.org)
#
proc slerp { alpha a b } {
  foreach {ax ay az aw} $a {break}
  foreach {bx by bz bw} $b {break}
  set cost [expr {$ax*$bx + $ay*$by + $az*$bz + $aw*$bw}]
  if {$cost < 0.0} {
    set cost [expr {-1.0 * $cost}]
    set bflip 1
  } else {
    set bflip 0
  }
  if {$alpha > 1.0} {
    set alpha 1.0
  } elseif {$alpha < 0.0} {
    set alpha 0.0
  }
  # Ease in and ease out of animation
  set Pi 3.14159265358979
  set alpha [expr {0.5 * (1.0 - cos($alpha * $Pi))}]
  if {(1.0 - $cost) < 1.e-06} {
    set beta [expr {1.0 - $alpha}]
  } else {
    set theta [expr {acos($cost)}]
    set phi $theta
    set sint [expr {sin($theta)}]
    set beta [expr {sin($theta - $alpha * $phi) / $sint}]
    set alpha [expr {sin($alpha * $phi) / $sint}]
  }
  if {$bflip} {
    set alpha [expr {-1.0 * $alpha}]
  }
  set qx [expr {$beta * $ax + $alpha * $bx}]
  set qy [expr {$beta * $ay + $alpha * $by}]
  set qz [expr {$beta * $az + $alpha * $bz}]
  set qw [expr {$beta * $aw + $alpha * $bw}]
  return [list $qx $qy $qz $qw]
}

proc axisAngleToQuat { axis angle } {
  set axis [ggu::vec3Normalize $axis]
  # convert from degrees to radians and negate
  set Pi 3.14159265358979
  set angle [expr {fmod($angle, 360.0) * $Pi / 180.0}]
  set u [expr {sin(0.5 * $angle)}]
  set axis [ggu::vec3Scale $axis $u]
  foreach {x y z} $axis {break}
  set w [expr {cos(0.5 * $angle)}]
  return [list $x $y $z $w]
}

proc quatToAxisAngle { quat } {
  set q [quatNormalize $quat]
  set w [lindex $q 3]
  set Pi 3.14159265358979
  set degrees [expr {2.0 * acos($w) * 180.0 / $Pi}]
  set u [expr {sqrt(1.0 - $w * $w)}]
  if {0.0 == $u} {
    set u 1.0
  } else {
    set u [expr {1.0 / $u}]
  }
  set x [expr {[lindex $q 0] * $u}]
  set y [expr {[lindex $q 1] * $u}]
  set z [expr {[lindex $q 2] * $u}]
  return [list [list $x $y $z] $degrees]
}

proc quatToMatrix { q matName } {
  upvar $matName mat
  set q [quatNormalize $q]
  foreach {qx qy qz qw} $q {break}
  set Nq [expr {$qx * $qx + $qy * $qy + $qz * $qz + $qw * $qw}]
  if {$Nq > 0.0} {
    set s [expr {2.0 / $Nq}]
  } else {
    set s 0.0
  }
  set xs [expr {$qx * $s}]
  set ys [expr {$qy * $s}]
  set zs [expr {$qz * $s}]
  set wx [expr {$qw * $xs}]
  set wy [expr {$qw * $ys}]
  set wz [expr {$qw * $zs}]
  set xx [expr {$qx * $xs}]
  set xy [expr {$qx * $ys}]
  set xz [expr {$qx * $zs}]
  set yy [expr {$qy * $ys}]
  set yz [expr {$qy * $zs}]
  set zz [expr {$qz * $zs}]
  set mat(0,0) [expr {1.0 - ($yy + $zz)}]
  set mat(1,0) [expr {$xy + $wz}]
  set mat(2,0) [expr {$xz - $wy}]
  set mat(3,0) 0.0
  set mat(0,1) [expr {$xy - $wz}]
  set mat(1,1) [expr {1.0 - ($xx + $zz)}]
  set mat(2,1) [expr {$yz + $wx}]
  set mat(3,1) 0.0
  set mat(0,2) [expr {$xz + $wy}]
  set mat(1,2) [expr {$yz - $wx}]
  set mat(2,2) [expr {1.0 - ($xx + $yy)}]
  set mat(3,2) 0.0
  set mat(0,3) 0.0
  set mat(1,3) 0.0
  set mat(2,3) 0.0
  set mat(3,3) 1.0
}

proc viewVectorToQuat { viewVec {upVec {0.0 1.0 0.0}}} {
  set viewVec [ggu::vec3Normalize $viewVec]
  set upVec [ggu::vec3Normalize $upVec]
  if {0.5 > [ggu::vec3Length $upVec]} {
    set upVec [list 0.0 1.0 0.0]
  }
  set sideVec [ggu::vec3Cross $viewVec $upVec]
  if {0.001 > [ggu::vec3Length $sideVec]} {
    set upVec [list 0.0 1.0 0.0]
    set sideVec [ggu::vec3Cross $viewVec $upVec]
    if {0.001 > [ggu::vec3Length $sideVec]} {
      set upVec [list 0.0 0.0 1.0]
      set sideVec [ggu::vec3Cross $viewVec $upVec]
    }
  }
  set sideVec [ggu::vec3Normalize $sideVec]
  set upVec [ggu::vec3Normalize [ggu::vec3Cross $sideVec $viewVec]]
  set mat(0,0) [lindex $sideVec 0]
  set mat(1,0) [lindex $sideVec 1]
  set mat(2,0) [lindex $sideVec 2]
  set mat(3,0) 0.0
  set mat(0,1) [lindex $upVec 0]
  set mat(1,1) [lindex $upVec 1]
  set mat(2,1) [lindex $upVec 2]
  set mat(3,1) 0.0
  set mat(0,2) [expr {-1.0 * [lindex $viewVec 0]}]
  set mat(1,2) [expr {-1.0 * [lindex $viewVec 1]}]
  set mat(2,2) [expr {-1.0 * [lindex $viewVec 2]}]
  set mat(3,2) 0.0
  set mat(0,3) 0.0
  set mat(1,3) 0.0
  set mat(2,3) 0.0
  set mat(3,3) 1.0
  return [matrixToQuat mat]
}

proc printQuat { q } {
  foreach {axis angle} [quatToAxisAngle $q] {break}
  return [format "%g %g %g  %g" [lindex $axis 0] [lindex $axis 1] \
    [lindex $axis 2] $angle]
}

proc setViewToQuat { q } {
  foreach {axis angle} [quatToAxisAngle $q] {break}
  gg::dispViewReset -rotation -norefresh
  gg::dispViewRot $axis [expr {-1.0 * $angle}]
}

proc alignViewAlongVec { secs viewVec {upVec {0.0 1.0 0.0}}} {
  set q0 [quatNormalize [getViewQuat]]
  set q1 [quatNormalize [viewVectorToQuat $viewVec $upVec]]
  set qdot 0.0
  for {set i 0} {$i < 4} {incr i} {
    set qdel [expr {[lindex $q0 $i] - [lindex $q1 $i]}]
    set qdot [expr {$qdot + $qdel * $qdel}]
  }
  set policy [gg::updatePolicy]
  if {1.0e-4 > $qdot || [string equal $policy "DELAYED"]} {
    setViewToQuat $q1
  } elseif {0 < $secs} {
    gg::updatePolicy DELAYED
    set deltaT $secs
    set dt 0.0
    set done 0
    for {set t0 0.0} {$done == 0} {} {
      set t0 [expr {$t0 + $dt}]
      if {$t0 > $deltaT} {
	set t0 $deltaT
	set done 1
      }
      set milsec [lindex [time {
	set q [slerp [expr {$t0 / $deltaT}] $q0 $q1]
	setViewToQuat $q
	update
	}] 0]
      if {10 > $milsec} {
	set milsec 10
      }
      set dt [expr {0.000001 * $milsec}]
    }
    gg::updatePolicy $policy
  } else {
    setViewToQuat $q1
    update
  }
}

proc doCancel { } {
  global widgets
  gg::dispViewReset -rotation -norefresh
  gg::dispViewRot $widgets(origAxis) $widgets(origAngle)
  foreach {widgets(origAxis) widgets(origAngle)} [gg::dispViewRot] {break}
  exit
}

proc doOK { } {
  doApply
  exit
}

proc doApply { } {
  global widgets
  if {$widgets(animate)} {
    wm withdraw .
    set secs 2.0
  } else {
    set secs 0.0
  }
  switch -exact -- $widgets(upVec) {
    "-X" {set upVec [list -1.0 0.0 0.0]}
    "+X" {set upVec [list 1.0 0.0 0.0]}
    "-Y" {set upVec [list 0.0 -1.0 0.0]}
    "+Y" {set upVec [list 0.0 1.0 0.0]}
    "-Z" {set upVec [list 0.0 0.0 -1.0]}
    "+Z" {set upVec [list 0.0 0.0 1.0]}
    default {set upVec [list 0.0 1.0 0.0]}
  }
  alignViewAlongVec $secs \
    [list $widgets(viewX) $widgets(viewY) $widgets(viewZ)] $upVec
  if {$widgets(animate)} {
    wm deiconify .
  }
}

proc checkInput { w var text action } {
  global widgets

  # Ignore forced validations
  if {$action == -1} {
    return 1
  }
  if {![string is double $text]} {
    set okay 0
  } elseif { [string equal "" $text] || abs($text) > 360.0 } {
    set okay 0
  } else {
    set okay 1
  }
  set widgets(${var}_valid) $okay

  if { $okay == 0 } {
    $w configure -bg "#FFCCCC"
  } else {
    $w configure -bg white
  }

  set okay 1
  foreach var [list viewX viewY viewZ] {
    if {$widgets(${var}_valid) == 0} {
      set okay 0
      break
    }
  }
  if {$okay} {
    set state normal
  } else {
    set state disabled
  }
  $widgets(apply) configure -state $state
  $widgets(ok) configure -state $state

  return 1
}

proc getViewQuat { } {
  foreach {axis angle} [gg::dispViewRot] {break}
  set q [axisAngleToQuat $axis [expr {-1.0 * $angle}]]
  return $q
}

proc getViewVec { } {
  set q [getViewQuat]
  quatToMatrix $q mat
  set x [expr {-1.0 * $mat(0,2)}]
  set y [expr {-1.0 * $mat(1,2)}]
  set z [expr {-1.0 * $mat(2,2)}]
  return [ggu::vec3Normalize [list $x $y $z]]
}

proc buildWidgets { } {
  global widgets

  foreach {widgets(origAxis) widgets(origAngle)} [gg::dispViewRot] {break}
  foreach {x y z} [getViewVec] {break}
  # round off really small numbers
  if {abs($x) < 1.0e-6} {
    set x 0.0
  }
  if {abs($y) < 1.0e-6} {
    set y 0.0
  }
  if {abs($z) < 1.0e-6} {
    set z 0.0
  }
  set widgets(viewX) $x
  set widgets(viewY) $y
  set widgets(viewZ) $z
  set widgets(viewX_valid) 1
  set widgets(viewY_valid) 1
  set widgets(viewZ_valid) 1

  set f [frame .top]
  pack $f

  set title [label $f.title -text "Set View Vector"]
  set font [$title cget -font]
  set fontFamily [font actual $font -family]
  set fontSize [font actual $font -size]
  set bigLabelFont [font create -family fontFamily -weight bold \
    -size [expr {2 * $fontSize}]]
  $title configure -font $bigLabelFont
  pack $title -side top -fill x -pady 5

  set hr [frame $f.hrTop -relief sunken -height 2 -bd 1]
  pack $hr -side top -padx 2 -fill x -pady 1

  set butWid 9
  set f2 [frame $f.input]
  set labelX [label "$f2.labelX" -text "X:" -anchor w]
  set enterX [entry "$f2.entryX" -width $butWid -textvariable widgets(viewX) \
    -validate all -vcmd [list checkInput %W viewX %P %d]]
  pack $labelX -side left
  pack $enterX -side left -padx 5
  set labelY [label "$f2.labelY" -text "Y:" -anchor w]
  set enterY [entry "$f2.entryY" -width $butWid -textvariable widgets(viewY) \
    -validate all -vcmd [list checkInput %W viewY %P %d]]
  pack $labelY -side left
  pack $enterY -side left -padx 5
  set labelZ [label "$f2.labelZ" -text "Z:" -anchor w]
  set enterZ [entry "$f2.entryZ" -width $butWid -textvariable widgets(viewZ) \
    -validate all -vcmd [list checkInput %W viewZ %P %d]]
  pack $labelZ -side left
  pack $enterZ -side left -padx 5
  pack $f2 -side top -pady 5

  set widgets(animate) 1
  set aniBut [checkbutton $f.checkAni -text "Animate Rotations" \
    -indicatoron TRUE -variable widgets(animate)]
  pack $aniBut -side top -expand false

  set f3 [frame $f.upVec]
  set labelUp [label "$f3.labelUp" -text "Up Direction:" -anchor e]
  pack $labelUp -side left
  set upVec $f3.upvec
  set widgets(upVec) "+Y"
  tk_optionMenu $upVec widgets(upVec) "-X" "+X" "-Y" "+Y" "-Z" "+Z"
  pack $upVec -side left -expand false
  pack $f3 -side top

  set hr [frame $f.hrBot -relief sunken -height 2 -bd 1]
  pack $hr -side top -padx 2 -fill x -pady 1
  set bf [frame $f.buttons]
  pack $bf -side top -fill x -pady 5
  set widgets(apply) [button $bf.apply -text "Apply" -command doApply]
  pack $widgets(apply) -side right -padx 2
  set widgets(cancel) [button $bf.cancel -text "Cancel" -command doCancel]
  pack $widgets(cancel) -side right -padx 2
  set widgets(ok) [button $bf.ok -text "OK" -command [list doOK]]
  pack $widgets(ok) -side right -padx 2
  if {![catch {pwiLogoCreate $bf.logo 1} b]} {
    $b configure -bd 0 -relief flat
    pack $b -side left -padx 5 -fill y
  }
}

gg::tkLoad
wm withdraw .
gg::updatePolicy DISPLAY_AND_INPUT
buildWidgets
::tk::PlaceWindow . widget
gg::tkLoop

#
# DISCLAIMER:
# TO THE MAXIMUM EXTENT PERMITTED BY APPLICABLE LAW, POINTWISE DISCLAIMS
# ALL WARRANTIES, EITHER EXPRESS OR IMPLIED, INCLUDING, BUT NOT LIMITED
# TO, IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE, WITH REGARD TO THIS SCRIPT.  TO THE MAXIMUM EXTENT PERMITTED 
# BY APPLICABLE LAW, IN NO EVENT SHALL POINTWISE BE LIABLE TO ANY PARTY 
# FOR ANY SPECIAL, INCIDENTAL, INDIRECT, OR CONSEQUENTIAL DAMAGES 
# WHATSOEVER (INCLUDING, WITHOUT LIMITATION, DAMAGES FOR LOSS OF 
# BUSINESS INFORMATION, OR ANY OTHER PECUNIARY LOSS) ARISING OUT OF THE 
# USE OF OR INABILITY TO USE THIS SCRIPT EVEN IF POINTWISE HAS BEEN 
# ADVISED OF THE POSSIBILITY OF SUCH DAMAGES AND REGARDLESS OF THE 
# FAULT OR NEGLIGENCE OF POINTWISE.
#