# OSG quaternions specific test procedures.
# These procedures are independent of the supplied Quat class type.
#
# Cnstr-Quat      Quat constructors.        Quat as result.
# Quat-Scalar     Quat as input.            Scalar as result.
# QuatScalar      Quat and scalar as input. No result.
# QuatScalar-Quat Quat and scalar as input. Quat as result.
# Quat-Quat       Quat as input.            Quat as result.
# QuatQuat        Quat and Quat as input.   No result.
# QuatQuat-Scalar Quat and Quat as input.   Scalar as result.
# QuatQuat-Quat   Quat and Quat as input.   Quat as result.
# Quat-Vec        Quat as input.            Vector as result.
# QuatMisc        Miscellaneous Quat tests: set, get, ...

package require tcl3d

source testUtil.tcl

# The wrapped OSG quaternion classes.
# Note: Currently there is only one class type for quaternions,
# but we use the same scheme as for vectors and matrices.
set quatAllClasses [list osg::Quat]

# Test procedure for the different types of Quat constructors.
proc Cnstr-Quat { quatType } {
    P "\nCnstr-Quat: $quatType Functionality: set Quat \[$quatType\]"

    set quat1 [osg::Quat]
    PN "Cnstr():" ; PQ $quat1

    set quat2 [osg::Quat a [CreateVec1 osg::Vec4f 4]]
    PN "Cnstr(Vec4f):" ; PQ $quat2

    set quat3 [osg::Quat a [CreateVec1 osg::Vec4d 4]]
    PN "Cnstr(Vec4d):" ; PQ $quat3

    set quat4 [osg::Quat a 45.0 [CreateVec1 osg::Vec3f 3]]
    PN "Cnstr(angle,Vec3f):" ; PQ $quat4

    set quat5 [osg::Quat a 45.0 [CreateVec1 osg::Vec3d 3]]
    PN "Cnstr(angle,Vec3d):" ; PQ $quat5

    set quat6 [osg::Quat a \
        45.0 [CreateUnitVec osg::Vec3f 3 0] \
        45.0 [CreateUnitVec osg::Vec3f 3 1] \
        45.0 [CreateUnitVec osg::Vec3f 3 2]]
    PN "Cnstr(3*(angle,Vec3f)):" ; PQ $quat6

    set quat7 [osg::Quat a \
        45.0 [CreateUnitVec osg::Vec3d 3 0] \
        45.0 [CreateUnitVec osg::Vec3d 3 1] \
        45.0 [CreateUnitVec osg::Vec3d 3 2]]
    PN "Cnstr(3*(angle,Vec3d)):" ; PQ $quat7
}

# Test procedure for methods returning scalar information about a Quat
# without the need to supply parameters.
proc Quat-Scalar { quatType quat } {
    P "\nQuat-Scalar: $quatType Functionality: set Scalar \[\$In method\]"
    PN "In $quatType" ; PQ $quat
    set size [$quat size]
    for { set i 0 } { $i < $size } { incr i } {
        set retVal [catch {eval $quat get $i} result]
        PN "Method get $i"
        if { $retVal == 0 } {
            P $result
        } else {
            P "Not supported"
        }
    }
    foreach m { x y z w size zeroRotation length length2 } {
        set retVal [catch {eval $quat $m} result]
        PN "Method $m"
        if { $retVal == 0 } {
            P $result
        } else {
            P "Not supported"
        }
    }
}

# Test procedure for methods operating directly on a Quad
# by supplying a scalar. 
proc QuatScalar { quatType quat sc } {
    P "\nQuatScalar: $quatType Functionality: \$In1 method \$In2"
    PN "In1 $quatType" ; PQ $quat
    foreach m { addSelf subSelf mulSelf divSelf } {
        set localQuat [$quat copy]
        set retVal [catch {eval $localQuat $m $sc} result]
        PN "Method $m"
        if { $retVal == 0 } {
            PQ "$localQuat"
        } else {
            P "Not supported"
        }
        $localQuat -delete
    }
    return $result
}

# Test procedure for methods returning a Quat generated
# by supplying a Quat and a scalar.
proc QuatScalar-Quat { quatType quat sc } {
    P "\nQuatScalar-Quat: $quatType Functionality: set Quat \[\$In1 method \$In2\]"
    PN "In1 $quatType" ; PQ $quat
    PN "In2"           ; P  $sc
    foreach m { mul div } {
        set retVal [catch {eval $quat $m $sc} result]
        PN "Method $m"
        if { $retVal == 0 } {
            PQ $result
        } else {
            P "Not supported"
        }
    }
    return $result
}

# Test procedure for methods returning a Quat generated
# by supplying a Quat.
proc Quat-Quat { quatType quat } {
    P "\nQuat-Quat: $quatType Functionality: set Quat \[\$In method\]"
    PN "In $quatType" ; PQ $quat
    foreach m { negate copy } {
        set retVal [catch {eval $quat $m} result]
        PN "Method $m"
        if { $retVal == 0 } {
            PQ "$result"
        } else {
            P "Not supported"
        }
    }
    return $result
}

# Test procedure for methods operating directly on a Quat
# by supplying another Quat. 
proc QuatQuat { quatType quat1 quat2 } {
    P "\nQuatQuat: $quatType Functionality: \$In1 method \$In2"
    PN "In1 $quatType" ; PQ $quat1
    PN "In2 $quatType" ; PQ $quat2
    foreach m { addSelf subSelf mulSelf divSelf } {
        set localQuat [$quat1 copy]
        set retVal [catch {eval $localQuat $m $quat2} result]
        PN "Method $m"
        if { $retVal == 0 } {
            PQ "$localQuat"
        } else {
            P "Not supported"
        }
        $localQuat -delete
    }
    return $result
}

# Test procedure for methods returning a scalar generated
# by supplying two Quats.
proc QuatQuat-Scalar { quatType quat1 quat2 } {
    P "\nQuatQuat-Scalar: $quatType Functionality: set Scalar \[\$In1 method \$In2\]"
    PN "In1 $quatType" ; PQ $quat1
    PN "In2 $quatType" ; PQ $quat2
    foreach m { eq ne less } {
        set retVal [catch {eval $quat1 $m $quat2} result]
        PN "Method $m"
        if { $retVal == 0 } {
            P $result
        } else {
            P "Not supported"
        }
    }
    return $result
}

# Test procedure for methods returning a Quat generated
# by supplying two Quats.
proc QuatQuat-Quat { quatType quat1 quat2 } {
    P "\nQuatQuat-Quat: $quatType Functionality: set Quat \[\$In1 method \$In2\]"
    PN "In1 $quatType" ; PQ $quat1
    PN "In2 $quatType" ; PQ $quat2
    foreach m { add sub mul div } {
        set retVal [catch {eval $quat1 $m $quat2} result]
        PN "Method $m"
        if { $retVal == 0 } {
            PQ $result
        } else {
            P "Not supported"
        }
    }
    return $result
}

# Test procedure for methods returning a vector casted from
# a supplied Quat.
proc Quat-Vec { quatType quat } {
    P "\nQuat-Vec: $quatType Functionality: set Vector \[\$In cast\]"
    PN "In $quatType" ; PQ $quat
    foreach m { asVec3 asVec4 } {
        set retVal [catch {eval $quat $m} result]
        PN "Method $m"
        if { $retVal == 0 } {
            PN "[GetPointerType [$result ptr]]"
            PV "$result"
        } else {
            P "Not supported"
        }
    }
    return $result
}

# Test procedure for methods not fitting into one of the above categories.
proc QuatMisc { quatType } {
    P "\nQuatMisc: $quatType Functionality: Miscellaneous"

    set quat1 [osg::Quat]
    $quat1 set 1 2 3 4
    PN "Method set xyzw:" ; PQ $quat1

    $quat1 set [CreateUnitVec osg::Vec4f 4 0]
    PN "Method set Vec4f:" ; PQ $quat1

    $quat1 set [CreateUnitVec osg::Vec4d 4 1]
    PN "Method set Vec4d:" ; PQ $quat1

    $quat1 set [osg::Matrixf m1 1 2 3 4  5 6 7 8  9 10 11 12  13 14 15 16]
    PN "Method set Matrixf:" ; PQ $quat1

    $quat1 set [osg::Matrixd]
    PN "Method set Matrixd:" ; PQ $quat1

    set quat2   [osg::Quat a 45.0 [CreateVec1 osg::Vec3d 3]]
    set tmpMatf [osg::Matrixf m2 1 2 3 4  5 6 7 8  9 10 11 12  13 14 15 16]
    $quat2 get $tmpMatf
    PN "Method get Matrixf:" ; PQ $quat2 ; PM $tmpMatf

    set tmpMatd [osg::Matrixd m3 1 2 3 4  5 6 7 8  9 10 11 12  13 14 15 16]
    $quat2 get $tmpMatd
    PN "Method get Matrixd:" ; PQ $quat2 ; PM $tmpMatd
}

P ">>> Test cases for osg::Quat class <<<\n"

foreach quatType $quatAllClasses {
    set idQuat [CreateDefaultQuat $quatType]
    set quat1  [CreateQuat1 $quatType]
    Cnstr-Quat      $quatType
    Quat-Scalar     $quatType $quat1
    QuatScalar      $quatType $quat1 2.5
    QuatScalar-Quat $quatType $quat1 2.5
    Quat-Quat       $quatType $quat1
    QuatQuat        $quatType $idQuat $quat1
    QuatQuat-Scalar $quatType $idQuat $quat1
    QuatQuat-Quat   $quatType $idQuat $quat1
    Quat-Vec        $quatType $quat1
    QuatMisc        $quatType
    $idQuat -delete
    $quat1  -delete
}

exit
