b26b8fc735
- Added strlcpy and strlcat to SICS - Added a driver for the POLDI power supplies SKIPPED: psi/A1931.c psi/autowin.c psi/bruker.c psi/docho.c psi/dornier2.c psi/dspcode.c psi/ease.c psi/ecb.c psi/ecbcounter.c psi/ecbdriv.c psi/el734dc.c psi/el734driv.c psi/el734hp.c psi/el737driv.c psi/el737hpdriv.c psi/el737hpdrivsps.c psi/el737hpv2driv.c psi/el755driv.c psi/eurodriv.c psi/haakedriv.c psi/itc4driv.c psi/julcho.c psi/linadriv.c psi/lmd200.c psi/lscsupport.c psi/ltc11.c psi/make_gen psi/oicom.c psi/oxinst.c psi/pimotor.c psi/pipiezo.c psi/polterwrite.c psi/psi.c psi/sanscook.c psi/sanslirebin.c psi/sanswave.c psi/sinqhmdriv.c psi/sinqhttp.c psi/slsecho.c psi/slsmagnet.c psi/slsvme.c psi/sps.c psi/swmotor.c psi/swmotor2.c psi/tabledrive.c psi/tasscan.c psi/tdchm.c psi/velodorn.c psi/velodornier.c
146 lines
4.9 KiB
Tcl
146 lines
4.9 KiB
Tcl
#----------------------------------------------------------
|
|
# 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
|
|
|
|
}
|