#----------------------------------------------------------
# This is a scriptcontext driver for a NHQ 202M high
# voltage power supply as used at the POLDI for the
# detector. This has a peculiar protocol and requires the 
# charbychar protocol driver.
#
# If this responds only with ?WCN, then it is on the wrong
# channel.
#
# Mark Koennecke, April 2010
#--------------------------------------------------------

namespace  eval nhq202m {}

#-------------------------------------------------------
# Sometimes numbers come in the form: polarity/mantissse/exponent
# This checks for this and converts it into a proper number
#-------------------------------------------------------
proc nhq202m::fixnumber {num} {
    set c [string index $num 0]
    if {[string compare $c -] == 0} {
	set num [string range $num 1 end]
    }
    clientput $num
    if {[string first - $num] > 0} {
	set l [split $num -]
	set man [string trimleft [lindex $l 0] 0]
	set exp [string trimleft [lindex $l 1] 0]
        clientput "$num, $man, $exp"
	return [expr $man * pow(10,-$exp)]
    } elseif { [string first + $num] > 0} {
	set l [split $num +]
	set man [string trimleft [lindex $l 0] 0]
	set exp [string trimleft [lindex $l 1] 0]
	return [expr $man * pow(10,$exp)]
    } else {
	return $num
    }
}
#-------------------------------------------------------
proc nhq202m::sendreadcommand {command} {
    sct send $command
    return readreply
}
#--------------------------------------------------------
proc nhq202m::readreply {} {
    set val [sct result]
    if {[string first ? $val] >= 0} {
	clientput "Read Command not understood, result = $val"
    } else {
	sct update [nhq202m::fixnumber $val]
    }
    return idle
}
#--------------------------------------------------------
proc nhq202m::sendwrite {command} {
    set val [sct target]
    sct send [format "%s=%d" $command $val]
    return writereply
}
#------------------------------------------------------
proc nhq202m::writereply {} {
    set val [sct result]
    if {[string first ? $val] >= 0} {
	clientput "Write command not understood, result = $val"
    } 
    [sct controller] queue [sct] progress read
    return idle
}
#----------------------------------------------------
proc nhq202m::startwrite {} {
    hupdate [sct]/stop 0
    set num [sct numpower]
    set com [format "D%1.1d" $num]
    nhq202m::sendwrite $com
    return setreply
}
#----------------------------------------------------
proc nhq202m::setreply {} {
    set val [sct result]
    if {[string first ? $val] >= 0} {
	clientput "Write command not understood, result = $val"
    } 
    set num [sct numpower]
    sct send  [format "G%1.1d" $num]
    return goreply
}
#----------------------------------------------------
proc nhq202m::goreply {} {
    set badcodes [list MAN ERR OFF]
    set val [sct result]
    if {[string first ? $val] >= 0} {
	clientput "Write command not understood, result = $val"
    } 
    set l [split $val =]
    set code [string trim [lindex $l 1]]
    if {[lsearch $badcodes $code] >= 0} {
	hupdate [sct]/stop 1 
	error "Bad code in $val, probably front panel switches fucked up"
    }
    return idle
}
#----------------------------------------------------
proc nhq202m::makehv {name sct num} {
  makesctdriveobj $name float mugger NHQ202M $sct
  hfactory /sics/${name}/tolerance plain mugger int
  hset /sics/${name}/tolerance 2
  hfactory /sics/${name}/upperlimit plain mugger int
  hset /sics/${name}/upperlimit 4000
  hfactory /sics/${name}/lowerlimit plain mugger int
  hset /sics/${name}/lowerlimit 0
  hfactory /sics/${name}/stop plain mugger int
  hset /sics/${name}/stop 0
  
  hsetprop /sics/${name} checklimits stddrive::stdcheck $name
  hsetprop /sics/${name} checkstatus stddrive::stdstatus $name
  hsetprop /sics/${name} halt stddrive::stop $name

  hsetprop /sics/${name} read nhq202m::sendreadcommand [format "U%1.1d" $num]
  hsetprop /sics/${name} readreply nhq202m::readreply
  hsetprop /sics/${name} numpower $num
  hsetprop /sics/${name} write nhq202m::startwrite
  hsetprop /sics/${name} setreply nhq202m::setreply
  hsetprop /sics/${name} goreply nhq202m::goreply
  $sct write /sics/${name}
  $sct poll /sics/${name} 180
  $sct queue /sics/${name} progress read 

  hfactory /sics/${name}/ramp plain mugger int
  hsetprop /sics/${name}/ramp read nhq202m::sendreadcommand [format "V%1.1d" $num]
  hsetprop /sics/${name}/ramp readreply nhq202m::readreply
  hsetprop /sics/${name}/ramp write nhq202m::sendwrite [format "V%1.1d" $num]
  hsetprop /sics/${name}/ramp writereply nhq202m::writereply
  $sct poll /sics/${name}/ramp 180
  $sct write /sics/${name}/ramp
  $sct queue /sics/${name}/ramp progress read


  hfactory /sics/${name}/current plain mugger int
  hsetprop /sics/${name}/current read nhq202m::sendreadcommand [format "N%1.1d" $num]
  hsetprop /sics/${name}/current readreply nhq202m::readreply
  $sct poll /sics/${name}/current 180
  $sct queue /sics/${name}/current progress read

}