#---------------------------------------------------------------
# This is for testing the new coordinated single crystal stuff 
# for SICS.
#
# Mark Koennecke, July - August 2008
#---------------------------------------------------------------
puts stdout "Testing Four Circle Codes"

set testub ".1215666 -.138694 -.0021278 -.1386887 -.1216454 .0010515 -.0049867 .0020612 -.081156"
set testcell "5.4202 5.4202 12.3228 90. 90. 90."
singlex mode bi

#---------------------------------------------------------------
proc testReflection {ref} {
    drive h [lindex $ref 0] k [lindex $ref 1] l [lindex $ref 2]
    set stt [SICSValue a4]
    compareValue $stt [lindex $ref 3]
    set om [SICSValue a3]
    compareValue $om [lindex $ref 4]
    set chi [SICSValue chi]
    compareValue $chi [lindex $ref 5]
    set phi [SICSValue phi]
    compareValue $phi [lindex $ref 6]
}
#--------------------------------------------------------------
proc testAng {ref} {
    set stt [SICSValue a4]
    compareValue $stt [lindex $ref 0]
    set om [SICSValue a3]
    compareValue $om [lindex $ref 1]
    set chi [SICSValue chi]
    compareValue $chi [lindex $ref 2]
    set phi [SICSValue phi]
    compareValue $phi [lindex $ref 3]
}
#======================= Tests =================================
test singlex-1.0 {Testing Setting Lambda} -body {
    testPar  "singlex lambda" 1.1785 User
    return OK
} -result OK

test singlex-1.1 {Testing Mode Setting} -body {
    testPar  "singlex mode" bi User
    testPar  "singlex mode" nb User
    testPar  "singlex mode" tas User
    set test [catch {singlex mode shitty} msg]
    if {$test == 0} {
	if {[string first ERROR $msg] < 0} {
	    error "Test for shitty mode failed"
	}
    }
    return OK
} -result OK

test singlex-1.2 {Testing Setting Cell} -body {
    testMultiPar "singlex cell" $testcell User
    return OK
} -result OK

test singlex-1.3 {Testing Setting UB} -body {
    testMultiPar "singlex ub" $testub User
    return OK
} -result OK

config rights User User
singlex ub $testub
singlex lambda 1.178

test singlex-1.4 {Driving Reflection} -body {
    set ref [list 2 2 0 35.80 17.90 180.6425 86.229]
    testReflection $ref
    return OK
} -result OK

test singlex-1.5 {Driving Reflection though hkl} -body {
    hkl drive 2 2 0
    set ref [list 35.80 17.90 180.6425 86.229]
    testAng $ref
    return OK
} -result OK


test singlex-1.6 {UB Calculation, 2 Reflections, Cell} -body {
    singlex cell $testcell
    ref clear
    ref addax 2 2 0 35.80 17.90 180.642 86.229
    ref addax 0 0 3 16.498 8.249 268.331 333.714
    ubcalc ub2ref 0000 0001
    ubcalc activate
    set ubr [SICSValue "singlex ub"]
    compareMultiValue $ubr $testub
    return OK
} -result OK

test singlex-1.7 {UB Calculation, 3 Reflections} -body {
    ref clear
    ref addax 2 2 0 35.80 17.90 180.642 86.229
    ref addax 0 0 3 16.498 8.249 268.331 333.714
    ref addax 1 0 0 12.478 6.239 181.549 131.232
    ubcalc ub3ref 0000 0001 0002
    ubcalc activate
    set ubr [SICSValue "singlex ub"]
    compareMultiValue $ubr $testub
    return OK
} -result OK

test singlex-1.8 {Cell from UB} -body {
    ref clear
    ref addax 2 2 0 35.80 17.90 180.642 86.229
    ref addax 0 0 3 16.498 8.249 268.331 333.714
    ref addax 1 0 0 12.478 6.239 181.549 131.232
    ubcalc ub3ref 0000 0001 0002
    set cell [ubcalc cellub]
    compareMultiValue $cell $testcell .03
    return OK
} -result OK

#-------------------------------------------------------------
# more tests for NB mode
#-------------------------------------------------------------
config rights Mugger Mugger
singlex mode nb
config rights User User

singlex ub  0.0228379 0.0773564 0.0476423 -0.1007840 0.0437923 0.0051331 -0.0213284 -0.0568516 0.0940093
set testub "0.0228379 0.0773564 0.0476423 -0.1007840 0.0437923 0.0051331 -0.0213284 -0.0568516 0.0940093"
singlex cell 9.663 9.663 9.663 81.496 81.496 81.496
ref clear
ref addax 1 -2 -1 17.889732 -123.9175 -0.1104
ref addax 1 1 1   10.621792 -14.005692 0.804147
ref addax -1 2 1   17.8897  56.069 -.154

proc testNBReflection {ref} {
    drive h [lindex $ref 0] k [lindex $ref 1] l [lindex $ref 2]
    set stt [SICSValue a4]
    compareValue $stt [lindex $ref 3]
    set om [SICSValue a3]
    compareValue $om [lindex $ref 4]
    set  nu [SICSValue nu]
    compareValue $nu [lindex $ref 5]
}
#--------------------------------------------------------------
proc testNBAng {ref} {
    set stt [SICSValue a4]
    compareValue $stt [lindex $ref 0]
    set om [SICSValue a3]
    compareValue $om [lindex $ref 1]
    set nu [SICSValue nu]
    compareValue $nu [lindex $ref 2]
}

test singlex-1.9 {Driving NB Reflection} -body {
    set ref [list 1 -2 -1 17.889 -123.9175 -0.1104]
    testNBReflection $ref
    return OK
} -result OK


test singlex-1.10 {Driving NB- Reflection though hkl} -body {
    hkl drive 1 -2 -1
    set ref [list 17.889 -123.9175 -0.1104]
    testNBAng $ref
    return OK
} -result OK

test singlex-1.11 {UB Calculation,NB, 2 Reflections, Cell} -body {
    ubcalc ub2ref 0000 0001
    ubcalc activate
    set ubr [SICSValue "singlex ub"]
    compareMultiValue $ubr $testub
    return OK
} -result OK

test singlex-1.12 {UB Calculation,NB, 3 Reflections} -body {
    ubcalc ub3ref 0000 0001 0002
    ubcalc activate
    set ubr [SICSValue "singlex ub"]
    compareMultiValue $ubr $testub
    return OK
} -result OK

config rights Mugger Mugger
singlex mode bi
config rights User User