# Some useful functions for SICS configuration.

# $Revision: 1.7 $
# $Date: 2007-09-26 06:23:57 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by $Author: ffr $

source util/extra_utility.tcl
source util/command.tcl

# Returns attribute name and value
proc getatt {sicsobj att} {
  lindex [split [tolower_sicslist $sicsobj $att] =] 1
}

# Utility fucntion for setting the home and upper and lower
# limits for a motor
proc setHomeandRange {args} {
set usage "
Usage: setHomeandRange -motor motName -home homeVal -lowrange low -uprange high
eg
setHomeandRange -motor mchi -home 90 -lowrange 5 -uprange 7
this sets the home position to 90 degreess for motor mchi
with the lower limit at 85 and the upper limit at 97
"
if {$args == ""} {clientput $usage; return}
  array set params $args
  set motor $params(-motor) 
  set home $params(-home)
  set lowlim [expr $home - $params(-lowrange)]
  set uplim [expr $home + $params(-uprange)]

  uplevel 1 "$motor softlowerlim $lowlim"
  uplevel 1 "$motor softupperlim $uplim"
  uplevel 1 "$motor home $home"
}

# Use this to create an array of named parameters to initialise motors.
proc params {args} {
  upvar 1 "" x;
  if [info exists x] {unset x}
  foreach {k v} $args {set x([string tolower $k]) $v}
}

# Parse motor readings for virtual motor scripts.
proc SplitReply { text } {
     set l [split $text =]
     return [string trim [lindex $l 1]]
}

# Sets motor position reading to pos by adjusting the softzero
proc setpos {motor pos} {
    set currPos [SplitReply [$motor]]
    set oldZero [SplitReply [$motor softzero]]
    set newZero [expr $currPos - $pos + $oldZero]
    uplevel #0 "$motor softzero $newZero"
}

proc getinfo {object} {
  set wc [format "%s_*" $object];
  set objlist [sicslist match $wc];
  foreach v $objlist {
    if { [SplitReply [sicslist $v type]]== "SicsVariable"} { 
      clientput [$v];
    }
  }
}


# Convenience function for setting klass group and name attributes 
# on sics object metadata
proc set_sicsobj_atts {sobj aklass agroup aname acontrol adata} {
  sicslist setatt $sobj klass $aklass;
  if {$agroup != "@none"} {
    sicslist setatt $sobj group $agroup;
  }
  sicslist setatt $sobj long_name $aname;
  sicslist setatt $sobj control $acontrol;
  sicslist setatt $sobj data $adata;
}

## TODO put all the utility macros in the utility namespace
namespace eval utility {
  variable instrument_names [list echidna wombat kowari quokka platypus pelican taipan]
  variable sics_port
  set base_port 60000
  set currbase $base_port
  foreach inst $instrument_names {
    array set sics_port [list\
      telnet-$inst $currbase\
      interrupt-$inst [expr {$currbase+1}]\
      server-$inst [expr {$currbase+2}]\
      quieck-$inst [expr {$currbase+3}]\
    ]
    set currbase [expr {$currbase+100}]
  }
  namespace export instname;
  namespace export get_portnum;
  variable instrument_name;
  set instrument_name "";

# Convenience command for getting unadorned instrument name
  proc instname {} {
    variable instrument_name;
    set instrument_name [SplitReply [instrument]];
    proc ::utility::instname {} {
      variable instrument_name;
      return $instrument_name;
    }
    return $instrument_name;
  }

# Initialise the attributes of sobj 
# to make it ready for adding to the hdb tree.
proc mkData {sobj name aklass args} {
  sicslist setatt $sobj long_name $name
  sicslist setatt $sobj nxalias $sobj
  sicslist setatt $sobj klass $aklass
  switch [getatt $sobj type] { 
    "sicsvariable" {
      sicslist setatt $sobj kind hobj
      sicslist setatt $sobj data true
      sicslist setatt $sobj control true
      sicslist setatt $sobj nxsave true
      sicslist setatt $sobj privilege internal
      sicslist setatt $sobj mutable false
    }
    default {
      error "ERROR [info level -1] -> [info level 0]"
    }
  }
  array set attval $args
  foreach att {kind data control nxsave privilege nxalias mutable} {
    if {[info exists attval($att)]} {
      sicslist setatt $sobj $att $attval($att)
    }
  }
}
# Sets the privilege attribute when making a SICS variable
# access = spy, user, manager, internal, readonly
  proc mkVar {name type access {along_name x} {anxsave false} {aklass @none} {acontrol false} {adata false}} {
    array set sicsAccess {spy spy user user manager mugger internal internal readonly internal}
    VarMake $name $type $sicsAccess($access);
    sicslist setatt $name privilege $access; 
    sicslist setatt $name kind hobj; 
    sicslist setatt $name mutable false
    if {$access != "internal"} {
      sicslist setatt $name data $adata
      sicslist setatt $name control $acontrol
      sicslist setatt $name nxsave $anxsave
      sicslist setatt $name klass $aklass
      sicslist setatt $name long_name $along_name
    }
  }

  proc about {option args} {
    return [info $option $args];
  }
}

proc debug {args} {
  clientput $args
}
proc echo {args} {
  clientput $args
}

proc ::utility::set_sobj_attributes {} {
  sicslist setatt getinfo privilege internal
  sicslist setatt setpos privilege internal
  sicslist setatt SplitReply privilege internal
  sicslist setatt instname privilege internal
}

proc ::utility::set_histomem_attributes {} {
  foreach hm [sicslist type histmem] { 
    sicslist setatt $hm nxalias $hm
    sicslist setatt $hm mutable true
  }
}
proc ::utility::set_motor_attributes {} {
# Bug: SICS-57 on Jira
# The first entry in [sicslist type motor] is 'motor' when
# we run the sicslist command on initialisation.  This is because
# The 'Motor' command has type motor, so we skip it with lrange.
  foreach m [lrange [sicslist type motor] 1 end] { 
    sicslist setatt $m kind hobj
    sicslist setatt $m data true
    sicslist setatt $m control true
    sicslist setatt $m nxsave true
    sicslist setatt $m mutable true
    sicslist setatt $m units [SplitReply [$m units]]
    sicslist setatt $m long_name [SplitReply [$m long_name]]
    set mpart [split [SplitReply [$m part] ] .]
    sicslist setatt $m klass [lindex $mpart 0]
    if {[llength $mpart] == 2} {
      sicslist setatt $m group [lindex $mpart 1]
    }
    sicslist setatt $m nxalias $m
    switch [expr int([SplitReply [$m accesscode]])] {
      0 {sicslist setatt $m privilege internal}
      1 {sicslist setatt $m privilege manager}
      2 {sicslist setatt $m privilege user}
      3 {sicslist setatt $m privilege spy}
    }
  }
  foreach m [sicslist type configurablevirtualmotor] { 
    sicslist setatt $m kind hobj
    sicslist setatt $m data true
    sicslist setatt $m control true
    sicslist setatt $m nxsave true
    sicslist setatt $m privilege user
    sicslist setatt $m nxalias $m
    sicslist setatt $m mutable true
  }
}
proc ::utility::set_envcontrol_attributes {} {
  foreach ec [sicslist type environment_controller] {
    sicslist setatt $ec kind hobj
    sicslist setatt $ec data true
    sicslist setatt $ec control true
    sicslist setatt $ec nxsave true
    sicslist setatt $ec privilege user
    sicslist setatt $ec nxalias $ec
    sicslist setatt $ec mutable true
    sicslist setatt $ec klass sample
  }
}

# Retuns plain value of hdb node property
proc ::utility::hgetplainprop {hpath prop} {
  return [string trim [lindex [split [hgetprop $hpath $prop] =] 1] ]
}
proc ::utility::hlistplainprop {hpath} {
  return [string trim [join [split [hlistprop $hpath] =] ]]
}

proc ::utility::GetUID {userName} {
  set fh [open /etc/passwd r]
    while {[gets $fh tmpName] != -1} {
      if {1 == [regexp "^$userName:" $tmpName]} {
        close $fh
          return [lindex [split $tmpName :] 2]
      }
    }
  close $fh error "\"$userName\" not found in /etc/passwd"
}

##\brief Determine if list l1 begins with list l2
proc lstarts_with {l1 l2} {
  foreach {e2} $l2 {e1} $l1 {
    if {$e2 == ""} {return 1}
    if {$e1 != $e2} {
      return 0
    }
  }
  return 1
}

##\brief Useful for converting port names to numbers for configuration parameters.
#
#\param port this can either be a port name or number
#\return always returns the port number
proc ::utility::get_portnum {port} { 
  global env tcl_platform
  variable sics_port 
  if [string is integer $port] {
    return $port
  } else {
    set home_path_list [split [string trim $env(HOME) /] /]
    set pwd_path_list [split [string trim $env(PWD) /] /]
    if [lstarts_with $pwd_path_list $home_path_list] {
      return [expr $sics_port($port) + 10*([::utility::GetUID $tcl_platform(user)]-999)]
    } else {
      return [portnum $port]
    }
  }
}

namespace import ::utility::*;
Publish getinfo spy
Publish setpos user
Publish SplitReply user
Publish instname user