#----------------------------------------------------------------------
# This is a set of regression tests for the tasub module. 
# This module does the UB matrix algorithm as described by Mark Lumsden 
# triple axis spectrometers.
#
# Mark Koennecke, November 2006
#----------------------------------------------------------------------
puts stdout "Testing Tasub"
#----------------------------------------------------------------------
# testTasubCalculation tests the tasub calculation. The input is a list
# containg the cell constants and two lists denoting reflections. 
# For each reflection the list must hold:
#            0  1  2  3  4  5  6  7  8  9   10 11 12
#           qh qk ql ei ef a1 a2 a3 a4 sgu sgl a5 a6
# testTasubCalculation then inputs the cell and the reflections into 
# tasub and calculates a UB from that. Then  it tries to drive to the 
# QE positions given for the reflections and checks if the angles are right
# It also checks QE positions in order to check if they have been properly
# updated.
# This then can be used with various inputs to check various configurations
# of the instrument. 
#----------------------------------------------------------------------
proc testTasubCalculation {cell ref1 ref2} {
    if {[llength $cell] < 6} {
	error "Not enough cell parameters"
    }
    if {[llength $ref1] < 13} {
	error "Not enough parameters for reflection 1"
    }	    
    if {[llength $ref2] < 13} {
	error "Not enough parameters for reflection 2"
    }
    checkSettingCell $cell
    checkMakeUB $ref1 $ref2
    checkDrivingReflection $ref1
    checkDrivingReflection $ref2
}
#-------------------------------------------------------------------
proc checkSettingCell {cell} {
    config rights Mugger Mugger
    append cmd "tasub cell " [join $cell]
    testOK $cmd
    set readback [string trim [SICSValue "tasub cell"]]
    set l [split $readback]
    for {set i 0} {$i < [llength $cell]} {incr i} {
	set ori [lindex $cell $i]
	set val [lindex $l $i]
	if {abs($ori - $val) > .01} {
	    error "Bad cell readback, in $cell, back $readback"
        }
    }
}
#---------------------------------------------------------------------
proc checkMakeUB {ref1 ref2} {
    checkOK "tasub clear"
    set cmd [format "tasub addref %f %f %f %f %f %f %f %f %f" \
		 [lindex $ref1 0] [lindex $ref1 1] [lindex $ref1 2] \
		 [lindex $ref1 7] [lindex $ref1 8] [lindex $ref1 9] \
		 [lindex $ref1 10] \
		 [lindex $ref1 3]  [lindex $ref1 4]]
   eval $cmd
   set cmd [format "tasub addref %f %f %f %f %f %f %f %f %f" \
		 [lindex $ref2 0] [lindex $ref2 1] [lindex $ref2 2] \
		 [lindex $ref2 7] [lindex $ref2 8] [lindex $ref2 9] \
		 [lindex $ref2 10] \
		 [lindex $ref2 3]  [lindex $ref2 4]]
   eval $cmd
   set test [tasub makeub 1 2]
   if {[string first ERROR $test] > 0} {
       error "Problem calculating UB: $test"
   }
}
#--------------------------------------------------------------------
proc checkDrivingReflection {ref} {
    set cmd [format "drive qh %f qk %f ql %f ei %f ef %f" \
		 [lindex $ref 0] [lindex $ref 1] [lindex $ref 2] \
		 [lindex $ref 3] [lindex $ref 4]]
    set test [eval $cmd]
    puts $cmd
    if {[string first ERROR $test] >= 0} {
	error "Failed to drive reflection: $test" 
    }
    set a1 [SICSValue a1]
    set a1soll [lindex $ref 5]
    if {abs($a1soll - $a1) >.01} {
	error "Bad a1 position, should $a1soll, is $a1" 
    } 
    set a1 [SICSValue a1]
    set a1soll [lindex $ref 5]
    if {abs($a1soll - $a1) >.01} {
	error "Bad a1 position, should $a1soll, is $a1" 
    } 
    set a2 [SICSValue a2]
    set a2soll [lindex $ref 6]
    if {abs($a2soll - $a2) >.01} {
	error "Bad a2 position, should $a2soll, is $a2" 
    } 
    set a3 [SICSValue a3]
    set a3soll [lindex $ref 7]
    if {abs($a3soll - $a3) >.01} {
	error "Bad a3 position, should $a3soll, is $a3" 
    } 
    set a4 [SICSValue a4]
    set a4soll [lindex $ref 8]
    if {abs($a4soll - $a4) >.01} {
	error "Bad a4 position, should $a4soll, is $a4" 
    } 
    set sgu [SICSValue sgu]
    set sgusoll [lindex $ref 9]
    if {abs($sgusoll - $sgu) >.01} {
	error "Bad sgu position, should $sgusoll, is $sgu" 
    } 
    set sgl [SICSValue sgl]
    set sglsoll [lindex $ref 10]
    if {abs($sglsoll - $sgl) >.01} {
	error "Bad sgl position, should $sglsoll, is $sgl" 
    } 
    set a5 [SICSValue a5]
    set a5soll [lindex $ref 11]
    if {abs($a5soll - $a5) >.01} {
	error "Bad a5 position, should $a5soll, is $a5" 
    } 
    set a6 [SICSValue a6]
    set a6soll [lindex $ref 12]
    if {abs($a6soll - $a6) >.01} {
	error "Bad a6 position, should $a6soll, is $a6" 
    } 

    set qh [SICSValue qh]
    set qhsoll [lindex $ref 0]
    if {abs($qhsoll - $qh) >.01} {
	error "Bad qh position, should $qhsoll, is $qh" 
    } 
    set qk [SICSValue qk]
    set qksoll [lindex $ref 1]
    if {abs($qksoll - $qk) >.01} {
	error "Bad qk position, should $qksoll, is $qk" 
    } 
    set ql [SICSValue ql]
    set qlsoll [lindex $ref 2]
    if {abs($qlsoll - $ql) >.01} {
	error "Bad ql position, should $qlsoll, is $ql" 
    } 

    set ei [SICSValue ei]
    set eisoll [lindex $ref 3]
    if {abs($eisoll - $ei) >.01} {
	error "Bad ei position, should $eisoll, is $ei" 
    } 
    set ef [SICSValue ef]
    set efsoll [lindex $ref 4]
    if {abs($efsoll - $ef) >.01} {
	error "Bad ef position, should $efsoll, is $ef" 
    } 
}
#===================== tests =========================================
test tasub-1.0 {Test setting dd} -body {
    testPar "tasub mono dd" 3.35461 Mugger
    testPar "tasub ana  dd" 3.35461 Mugger
    return OK
} -result OK

test tasub-1.1 {Test setting ss} -body {
    testPar "tasub mono ss" 1 Mugger
    testPar "tasub ana  ss" 1 Mugger
    return OK
} -result OK

test tasub-1.2 {Test setting sample configuration} -body {
    testPar "tasub const" kf Mugger
    testPar "tasub ss" -1 Mugger
    return OK
} -result OK

test tasub-1.3 {Test clearing tasub} -body {
    testOK "tasub clear"
    return OK
} -result OK

test tasub-1.4 {Test setting cell} -body {
    checkSettingCell [list 7. 7. 7. 90. 90. 90.]
    return OK
} -result OK

tasub mono dd 3.35461
tasub ana  dd 3.35461
tasub mono ss 1
tasub ana ss 1
tasub const kf
tasub ss -1

test tasub-1.5 {Basic calculation test} -body {
    set ref1 [list 1 0 0 5 5  37.075 74.150 168.27 -23.46 0 0 37.075 74.15] 
    set ref2 [list 0 0 1 5 5  37.075 74.150  84.78 -10.44 0 0 37.075 74.15] 
    set cell [list 9.95 9.95 22.24 90 90 90]
    testTasubCalculation $cell $ref1 $ref2
    return OK
} -result OK


test tasub-1.6 {Test driving ei} -body {
    drive ei 5.0
    set eit [SICSValue ei]
    set a1 [SICSValue a1]
    set a2 [SICSValue a2]
    if {abs(5 - $eit) > .001} {
	error "Readback of ei failed"
    }
    if {abs(37.07 - $a1) > .01} {
	error "Bad a1 value, is $a1, should 37.07"
    }
    if {abs(74.15 - $a2) > .01} {
	error "Bad a2 value, is $a2, should 74.15"
    }
    return OK
} -result OK

test tasub-1.7 {Test driving ef} -body {
    drive ef 5.
    set eit [SICSValue ef]
    set a1 [SICSValue a5]
    set a2 [SICSValue a6]
    if {abs(5. - $eit) > .001} {
	error "Readback of ei failed"
    }
    if {abs(37.07 - $a1) > .01} {
	error "Bad a5 value, is $a1, should 37.07"
    }
    if {abs(74.15 - $a2) > .01} {
	error "Bad a6 value, is $a2, should 74.15"
    }
    return OK
} -result OK

test tasub-1.8 {Test reading en} -body {
    drive ei 5. ef 3.7
    set en [SICSValue en]
    if {abs($en - 1.3) > .01} {
	error "Bad en value: should: 1.3, is $en"
    }
    return OK
} -result OK

test tasub-1.9 {Test driving ef, different scattering sense} -body {
    tasub ana ss -1
    drive ef 5.0
    set eit [SICSValue ef]
    set a1 [SICSValue a5]
    set a2 [SICSValue a6]
    if {abs(5 - $eit) > .001} {
	error "Readback of ef failed"
    }
    if {abs(-37.07 - $a1) > .01} {
	error "Bad a5 value, is $a1, should -37.07"
    }
    if {abs(-74.15 - $a2) > .01} {
	error "Bad a6 value, is $a2, should -74.15"
    }
    return OK
} -result OK