# This is a template driver for a device from vendor
#
# Author:   Douglas Clowes
# Date:     September 2011
#

set vendor "aerotech"
set device "soloist"

namespace eval ::scobj::[set vendor]_[set device] {
  # All of this takes place in a namespace based on the vendor and device
  # Debug prints and vendor/device save
  puts "Namespace: [namespace current]"
  puts "Vendor:[set vendor]"
  puts "Device:[set device]"
  set [namespace current]::vendor [set ::vendor]
  set [namespace current]::device [set ::device]
  set [namespace current]::ven_dev "[set ::vendor]_[set ::device]"
  puts "[namespace current]::vendor [set [namespace current]::vendor]"
  puts "[namespace current]::device [set [namespace current]::device]"
  puts "[namespace current]::ven_dev [set [namespace current]::ven_dev]"

  proc debug_log {debug_level arg_string} {
    # write a timestamped string message to a log file for debugging
    set catch_status [ catch {
      set debug_threshold 0
      if {$debug_level >= $debug_threshold} {
        set fd [open "[set [namespace current]::log_file]" "a" 0777]
        set catch_status [ catch {
          set line "[clock format [clock seconds] -format "%T"] $arg_string"
          puts $fd "$line"
      	} catch_message ]
        close $fd
      }
    } catch_message ]
  }

  proc ns {} {
    return "[namespace current]"
  }

  proc setValue {tc_root nextState cmd} {
    # send a command to set a value
    debug_log 1 "setValue tc_root=$tc_root sct=[sct] $cmd [sct target]"
    if { [hpropexists [sct] geterror] } {
      hdelprop [sct] geterror
    }
    set par [sct target]
    sct send "$cmd $par"
    return $nextState
  }

  proc chkWrite {tc_root} {
    # process the response to the write
    # - not all devices will respond to writes
    set data [sct result]
    debug_log 1 "chkWrite tc_root=$tc_root sct=[sct] resp=$data"
    if {[string equal -nocase -length 7 $data "ASCERR:"]} {
      # the protocol driver has reported an error
      sct geterror "$data"
    } elseif {[string equal -nocase -length 1 $data "?"]} {
      # the device has reported an error
      sct geterror "Error: $data"
    } else {
      # the write was successful, record the data
      set data [sct target]
      if {$data != [sct oldval]} {
        sct oldval $data
        sct update $data
        sct utime readtime
        debug_log 1 "chkWrite new data for $tc_root [sct] result=$data"
      }
    }
    return idle
  }

  proc nulWrite {tc_root} {
    set data "[sct result]"
    debug_log 1 "nulWrite tc_root=$tc_root sct=[sct] resp=$data"
    return idle
  }

  proc getValue {tc_root nextState cmd} {
    # send a command to request a value
    debug_log 1 "getValue tc_root=$tc_root sct=[sct] $cmd"
    if { [hpropexists [sct] geterror] } {
      hdelprop [sct] geterror
    }
    sct send "$cmd"
    return $nextState
  }

  proc rdValue {tc_root} {
    # process the received response to the read request
    debug_log 1 "rdValue tc_root=$tc_root sct=[sct] result=[sct result]"
    set data [sct result]
    if {[string equal -nocase -length 7 $data "ASCERR:"]} {
      # the protocol driver has reported an error
      sct geterror "$data"
    } elseif {[string equal -nocase -length 1 $data "!"]} {
      # the device has reported an error
      sct geterror "Error: $data"
    } elseif {[string equal -nocase -length 1 $data "%"]} {
      set val "[string range $data 1 end]"
      if { [string equal -nocase "[basename [sct]]" axisstatus] } {
        set txt ""
        set zzz [list   0   1   2   3   4   5   6   7   8   9  10  11  12  14  18  19  22  23  24  25  26  27  28  29  30  31]
        set xxx [list ena hom inp mov acc dec pca ccl brk cwi msc cac cen hmg afa cfd hlm llm hml mrk hia hib hic see cee est]
        for { set i 0 } {$i < [llength $zzz]} { incr i } {
          if { [string length $txt] > 0 } { set txt ":$txt" }
          if { ($val & (1 << int([lindex $zzz $i]))) == 0 } {
            set txt "[string tolower [lindex $xxx $i]]$txt"
          } else {
            set txt "[string toupper [lindex $xxx $i]]$txt"
          }
        }
        set val [format "0x%08X" $val]
      }
      if {$val  != [sct oldval]} {
        debug_log 1 "[sct] new:$val, old:[sct oldval]"
        sct oldval $val
        sct update $val
        sct utime readtime
        debug_log 1 "[pathname [sct]] new:$txt, old:[hval [pathname [sct]]]"
        hset "[pathname [sct]]/axistext" "$txt"
      }
    } else {
      set fields [split "$data"]
      set rate [lindex $fields end]
      debug_log 1 "Rate new:$rate, old:[sct oldval]"
      if {$rate  != [sct oldval]} {
        sct oldval $rate
        sct update $rate
        sct utime readtime
      }
    }
    return idle
  }

  ##
  # @brief createNode() creates a node for the given nodename with the properties given
  #
  # @param scobj_hpath    string variable holding the path to the object's base node in sics (/sample/tc1)
  # @param sct_controller name of the scriptcontext object (typically sct_xxx_yyy)
  # @param cmdGroup       subdirectory (below /sample/tc*/) in which the node is to be created
  # @param varName        name of the actual node typically representing one device command
  # @param readable       set to 1 if the node represents a query command, 0 if it is not
  # @param writable       set to 1 if the node represents a request for a change in settings sent to the device
  # @param drivable       if set to 1 it prepares the node to provide a drivable interface
  # @param dataType       data type of the node, must be one of none, int, float, text
  # @param permission     defines what user group may read/write to this node (is one of spy, user, manager)
  # @param rdCmd          actual device query command to be sent to the device
  # @param rdFunc         nextState Function to be called after the getValue function, typically rdValue()
  # @param wrCmd          actual device write command to be sent to the device
  # @param wrFunc         Function to be called to send the wrCmd to the device, typically setValue()
  # @param allowedValues  allowed values for the node data - does not permit other
  # @param klass          Nexus class name (?)
  # @return               OK
  proc createNode {scobj_hpath sct_controller\
    cmdGroup varName\
    readable writable drivable\
    dataType permission\
    rdCmd rdFunc\
    wrCmd wrFunc\
    allowedValues klass} {

    set catch_status [ catch {
      set ns "[namespace current]"
      set nodeName "$scobj_hpath/$cmdGroup/$varName"
      if {1 > [string length $cmdGroup]} {
        set nodeName "$scobj_hpath/$varName"
      }
      debug_log 1 "Creating node $nodeName"
      hfactory $nodeName plain $permission $dataType
      if {$readable > 0} {
        # the node is readable so set it up to be polled using the rdFunc
        # rdFunc is getValueFunc.rdValueFunc with both explicit functions
        # or rdValueFunc where "getValue" is the implied getValueFunc
        set parts [split "$rdFunc" "."]
        if { [llength $parts] == 2 } {
          set func_name [lindex $parts 0]
          set next_state [lindex $parts 1]
        } else {
          set func_name "getValue"
          set next_state [lindex $parts 0]
        }
        hsetprop $nodeName read ${ns}::$func_name $scobj_hpath $next_state $rdCmd
        hsetprop $nodeName $next_state ${ns}::$next_state $scobj_hpath
        # set the poll rate as a period in seconds
        # TODO allow directly settable value in seconds
        set poll_period 30
        if { $readable >= 0 && $readable <= 9 } {
          set poll_period [lindex [list 0 1 2 3 4 5 10 15 20 30] $readable]
        }
        debug_log 1 "Registering node $nodeName for poll at $poll_period seconds"
        $sct_controller poll $nodeName $poll_period
      }
      if {$writable == 1} {
        # the node is writable so set it up to invoke a callback when written
        # rdFunc is putValueFunc.chkWriteFunc with both explicit functions
        # or putValueFunc where "noResponse" is the implied chkWriteFunc
        set parts [split "$wrFunc" "."]
        if { [llength $parts] == 2 } {
          set func_name [lindex $parts 0]
          set next_state [lindex $parts 1]
        } else {
          set func_name [lindex $parts 0]
          set next_state "noResponse"
        }
        hsetprop $nodeName write ${ns}::$func_name $scobj_hpath $next_state $wrCmd
        hsetprop $nodeName $next_state ${ns}::$next_state $scobj_hpath
        hsetprop $nodeName writestatus UNKNOWN
        debug_log 1 "Registering node $nodeName for write callback"
        $sct_controller write $nodeName
      }
      # Initialise the previous value to test against
      switch -exact $dataType {
        "none"  { }
        "int"   { hsetprop $nodeName oldval -1 }
        "float" { hsetprop $nodeName oldval -1.0 }
        default { hsetprop $nodeName oldval UNKNOWN }
      }
      # Set the allowed values property
      if {1 < [string length $allowedValues]} {
        hsetprop $nodeName values $allowedValues
      }
      # Drive adapter interface
      # TODO make it a separate function and pass in all this stuff
      if {$drivable == 1} {
        hsetprop $nodeName check ${ns}::check $scobj_hpath
        hsetprop $nodeName driving 0
        hsetprop $nodeName checklimits ${ns}::check $scobj_hpath
        hsetprop $nodeName checkstatus ${ns}::drivestatus $scobj_hpath
        hsetprop $nodeName halt ${ns}::halt $scobj_hpath
      } else {
        hsetprop $nodeName driving 0
      }
    } catch_message ]
    if {$catch_status != 0} {
      debug_log 5 "error in [ns]::createNode $catch_message"
      return -code error "in [ns]::createNode $catch_message"
    }
    return OK
  }

  proc mk_sct_driver {sct_controller klass name tol} {
    set [ns]::log_file "/tmp/[set [ns]::ven_dev]_${name}.log"
    debug_log 1 "mk_sct_driver $sct_controller $klass $name $tol"
    set catch_status [ catch {

      MakeSICSObj $name SCT_OBJECT
      sicslist setatt $name klass $klass
      sicslist setatt $name long_name $name

      set scobj_hpath /sics/$name

      set deviceCommand {\
        {}      axisstatus      1 0 0   text  user    {AXISSTATUS()}    {rdValue}       {}                {}                  {}\
        {}      axistext        0 0 0   text  user    {}                {}              {}                {}                  {}\
        {}      position        1 0 0   float user    {PFBK()}          {rdValue}       {}                {}                  {}\
        {}      velocity        1 0 0   float user    {VFBK()}          {rdValue}       {}                {}                  {}\
      }

      foreach {cmdGroup varName\
        readable writable drivable\
        dataType permission\
        rdCmd rdFunc\
        wrCmd wrFunc\
        allowedValues} $deviceCommand {
        createNode $scobj_hpath $sct_controller\
        $cmdGroup $varName\
        $readable $writable $drivable\
        $dataType $permission\
        $rdCmd $rdFunc\
        $wrCmd $wrFunc\
        $allowedValues $klass
      }

    } catch_message ]
    if {$catch_status != 0} {
      debug_log 5 "error in [ns]::mk_sct_driver $catch_message"
      return -code error "in [ns]::mk_sct_driver $catch_message"
    }
  }

  proc add_[set vendor]_[set device] {name IP port {_tol 5.0}} {
    ###puts "Namespace: [ns]"
    ###puts "::vendor $::vendor"
    ###puts "::device $::device"
    ###puts "[ns]::vendor [set [ns]::vendor]"
    ###puts "[ns]::device [set [ns]::device]"
    ###puts "[ns]::ven_dev [set [ns]::ven_dev]"
    set [ns]::log_file "/tmp/[set [ns]::ven_dev]_[set name].log"
    set fd [open "[set [namespace current]::log_file]" "w" 0777]
    close $fd
    debug_log 1 "add_[set [ns]::vendor]_[set [ns]::device] ${name} ${IP} ${port} ${_tol}"
    if {[SplitReply [environment_simulation]]=="false"} {
      debug_log 1 "makesctcontroller sct_${name} std ${IP}:${port}"
      makesctcontroller sct_${name} std ${IP}:${port} "\n" 30.0
    }
    debug_log 1 "mk_sct_driver sct_${name} environment ${name} ${_tol}"
    mk_sct_driver sct_${name} environment ${name} ${_tol}
  }


  namespace export add_[set vendor]_[set device]
}

namespace import ::scobj::[set vendor]_[set device]::*

#
# below this point is debugging only
#
if { "[lindex [split [info nameofexecutable] "/"] end]" == "tclsh"} {
  set catch_status [ catch {
    puts "TCLSH"
    proc environment_simulation {} { return "" }
    proc SplitReply {str} { return "" }
    proc makesctcontroller {args} { }
    proc MakeSICSObj {args} { }
    proc sicslist {args} { }
    proc hfactory {args} { }
    proc hsetprop {args} { }
    proc sct {args} {
      puts $args
    }

    proc sct_bm1 {args} { }
    add_ansto_bm "bm1" 127.0.0.1 4001 2.0

    proc sct_bm2 {args} { }
    add_ansto_bm "bm2" 127.0.0.1 4002 2.0

  } catch_message ]
  if {$catch_status != 0} {
    puts "error in main $catch_message"
    return -code error "in main $catch_message"
  }
}