sics/site_ansto/instrument/tas/config/tasmad/sicscommon/ccdwww.tcl

#------------------------------------------------------
# This is SICS HM driver code for the CCDWWW CCD camera
# WWW server as used at SINQ. It uses, of course, the
# scriptcontext asynchronous I/O system
#
# Mark Koennecke, September 2010
#-------------------------------------------------------

namespace eval ccdwww {}
#-------------------------------------------------------
# This is a default init script. The user has to initialise
# a list of nodes to send to the CCD in XML format as
# variable ccdwww::initnodes
#--------------------------------------------------------
proc ccdwww::initscript {name} {
  global ccdwww::initnodes

  append confdata "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
  foreach var $ccdwww::initnodes {
    set val [hval /sics/${name}/${var}]
    append confdata "<$var>$val</$var>\n"
  }
  return $confdata
}
#-------------------------------------------------------
proc ccdwww::httpsend {url} {
    sct send $url
    return httpreply
}
#-------------------------------------------------------
proc ccdwww::httpsendstart {url} {
    sct send $url
    return httpstartreply
}
#--------------------------------------------------------
proc ccdwww::httptest {data} {
    if {[string first ASCERR $data] >= 0} {
      error $data
    }
    if {[string first ERROR $data] >= 0} {
      error $data
    }
    return $data
}
#--------------------------------------------------------
proc ccdwww::httpreply {} {
    set reply [sct result]
    set status [catch {httptest $reply} data]
    if {$status != 0} {
      sct geterror $data
      clientput $data
    } else {
        hdelprop [sct] geterror
    }
    return idle
}
#---------------------------------------------------------
proc ccdwww::httpstartreply {} {
    set reply [sct result]
    set status [catch {httptest $reply} data]
    if {$status != 0} {
      sct geterror $data
    } else {
        hdelprop [sct] geterror
    }
    clientput $data
    after 100
    return idle
}
#---------------------------------------------------------
# A CCD works like a camera. When exposing, it cannot be stopped,
# paused or anything. This is why the appropriate methods
# here have no implementation
#----------------------------------------------------------
proc ccdwww::httpcontrol {} {
    set target [sct target]
    switch $target {
      1000 {
            set path [file dirname [sct]]
            set preset [hval $path/preset]
            set ret  [ccdwww::httpsendstart "/ccd/expose?time=$preset"]
	    hupdate $path/status run
            [sct controller] queue $path/status progress read
            return $ret
            }
      1001 {}
      1002 {}
      1003 {}
      1005 {
        set path [file dirname [sct]]
        set script [hval $path/initscript]
        set confdata [eval $script]
        clientput $confdata
        return [ccdwww::httpsend "post:/ccd/configure:$confdata"]
      }
      default {
        sct print "ERROR: bad start target $target given to control"
        return idle
       }
    }
}
#---------------------------------------------------------
proc ccdwww::httpdata {name} {
    set path "/sics/${name}/data"
    set com [format "node:%s:/ccd/data" $path]
    sct send $com
    return httpdatareply
}
#--------------------------------------------------------
proc ccdwww::httpdatareply {} {
    set status [catch {httpreply} txt]
    if {$status == 0} {
      set path [file dirname [sct]]
      hdelprop $path/data geterror
    }
    return idle
}
#--------------------------------------------------------
proc ccdwww::httpstatus {} {
    sct send /ccd/locked
    return httpevalstatus
}
#-------------------------------------------------------
proc ccdwww::httpstatusdata {} {
    catch {httpdatareply}
    sct update idle
    return idle
}
#---------------------------------------------------------
proc ccdwww::httpevalstatus {name} {
    set reply [sct result]
    set status [catch {httptest $reply} data]
    if {$status != 0} {
        sct geterror $data
        clientput $data
        sct update error
        return idle
    }
    hdelprop [sct] geterror
    if {$data == 0} {
      httpdata $name
      return httpstatusdata
    } else {
       sct update run
       [sct controller] queue [sct] progress read
       return idle
    }
}
#---------------------------------------------------------
proc ccdwww::MakeCCDWWW {name host initscript} {
    sicsdatafactory new ${name}transfer
    makesctcontroller ${name}sct sinqhttpopt $host ${name}transfer 600
    MakeSecHM $name 2
    hsetprop /sics/${name}/control write ccdwww::httpcontrol
    hsetprop /sics/${name}/control httpreply  ccdwww::httpreply
    hsetprop /sics/${name}/control httpstartreply  ccdwww::httpstartreply
    ${name}sct write /sics/${name}/control

    hsetprop /sics/${name}/data read ccdwww::httpdata $name
    hsetprop /sics/${name}/data httpdatareply  ccdwww::httpdatareply

    hsetprop /sics/${name}/status read ccdwww::httpstatus
    hsetprop /sics/${name}/status httpevalstatus ccdwww::httpevalstatus $name
    hsetprop /sics/${name}/status httpstatusdata ccdwww::httpstatusdata
    ${name}sct poll /sics/${name}/status 60

    hfactory /sics/${name}/initscript plain mugger text
    hset /sics/${name}/initscript $initscript
}