# config commands

namespace eval stdConfig {
}

namespace eval stdSct {
}

proc stdConfig::make args {
  scanargs $args arg -driver -name -ctrl 0 -base / -port 0 -permanent 0 -args

  variable driver $arg(driver)
  variable name $arg(name)
  variable base $arg(base)
  variable hostport $arg(port)
  variable makeargs $arg(args)
  variable permanent $arg(permanent)
  # permanent=0: object to be registered in obj_list
  #   therefore removed with samenv none
  # permanent=1: object created in init file
  #   no need to register make command in status file
  # permanent=2: object created on demand, persistent, removed only explicitly

  if {[string equal 0 $arg(ctrl)]} {
    variable ctrl _$name
  } else {
    variable ctrl $arg(ctrl)
  }
  if {[llength [info procs ${driver}]] == 0} {
# this is not needed when make is called from makenv, but on startup, when
# executing a creationCommand
    source_sct_driver $driver
  }
  set cmd [linsert $makeargs 0 $driver]
#  clientput "MCMD: $cmd"
  if {[catch {set des [eval $cmd]} msg]} {
    clientput "ERROR: calling stdConfig::$cmd:"
    clientput $msg
    return
  }
  if {$permanent == 0} {
    desc_env makeitem $name $des
    obj_list makeitem $name $des
    obj_dependencies makeitem $name $ctrl
  }
  put_secop_info $base$name
}

proc stdConfig::controllerDesc {desc} {
  variable ctrl
  variable permanent
  if {$permanent == 0} {
    obj_list makeitem $ctrl $desc
    desc_env makeitem $ctrl $desc
  }
}

proc stdConfig::controller {{prot std} args} {
  variable driver
  variable ctrl
  variable node
  variable resolution 5
  variable fastperiod 5
  variable slowperiod 10
  variable hostport
  variable permanent

  if {[lindex $args 0] eq "without_connection" || $prot eq "syncedprot"} {
    set hostport without_connection
  }
  set node /sics/$ctrl
  if {$hostport eq "0"} {
    set hostport [silent 0 result cfg_env $ctrl]
    if {$hostport eq "without_connection" || $hostport eq "0"} {
      set hostport unconnected:0
    }
  }
  if {[string index $hostport 0] eq "@"} {
    if {[sicsdescriptor alias_hostport] eq "notfound"} {
      makeobject alias_hostport array
    }
    alias_hostport makeitem $ctrl $hostport
    set hostport [silent 0 result cfg_env $hostport]
    if {[string equal 0 $hostport]} {
      set hostport unconnected:0
    }
  } else {
    catch {alias_hostport deleteitem $ctrl}
  }
  if {"$hostport" eq "undefined"} {
    set hostport $ctrl
  }
  set makecmd [concat makesctcontroller $ctrl $prot $hostport $args]
  # clientput "MSCT: $makecmd"
  if {[string equal SctController [sicsdescriptor $ctrl]]} {
    set _makecmd [hgetpropval $node _makecmd]
    hsetprop $node _makecmd $makecmd
    set makecmd [hgetpropval $node _makecmd]
    if {! [string equal $makecmd $_makecmd]} {
      hsetprop $node _makecmd $_makecmd
      error "shared controllers do not match\n(a) $_makecmd\n(b) $makecmd"
    }
    return 0
  }
  eval $makecmd

  prop _makecmd $makecmd
  prop idn ""
  prop tasksPath $node/tasks
  prop state idle
  prop read stdSct::read
  prop update stdSct::update
  prop write stdSct::write
  prop complete stdSct::completeUpdate
  prop commerror stdSct::errorScript
  set reconnect_script "$ctrl queue /sics/$ctrl/tasks start stdSct::prestart"
  prop reconnect_script $reconnect_script
  logsetup /sics/$ctrl 1

  set node /sics/$ctrl/tasks
  hfactory $node plain user none
  prop sync stdSct::sync
  prop start stdSct::start
  prop complete stdSct::completeStart
  eval $reconnect_script
 
  if {$permanent == 0} {
    obj_list makeitem $ctrl "$driver controller"
    desc_env makeitem $ctrl "$driver controller"
  }
  set node /sics/$ctrl
  return 1
}

proc stdSct::prestart {} {
  catch {
    set hp [[sct controller] hostport]
    set ip [[sct controller] ip]
    hupdate /sics/[sct controller] "$hp ($ip)"
  }
  return start
}

proc stdConfig::pollperiod {fast {slow 0} {res 0}} {
  if {$fast > 0} {
    variable fastperiod $fast
  }
  if {$slow > 0} {
    variable slowperiod $slow
  }
  if {$res > 0} {
    variable resolution $res
  } elseif {$fast > 0} {
    variable resolution $fast
  }
}

proc stdConfig::wr {{period 0} {prio slow} {action read}} {
  variable slowperiod
  variable node
  variable ctrl

  if {$period == 0} {
    set period $slowperiod
  }
  $ctrl write $node
  poll $period $prio $action
  prop geterror "not read yet"
  prop __save update
}

proc stdConfig::rd {{period 0} {prio read} {action read}} {
  variable fastperiod
  if {$period == 0} {
    set period $fastperiod
  }
  poll $period $prio $action
}

proc stdConfig::upd {} {
  variable ctrl
  variable node
  $ctrl connect $node
}

proc stdConfig::out {} {
  variable ctrl
  variable node
  $ctrl write $node
  prop __save update
}

proc stdConfig::par {value} {
  variable node
  hupdate $node $value
  prop __save update
}

proc stdConfig::treatProps {kind props} {
  variable level
  foreach line [split $props "\n"] {
    append prop $line
    if {[info complete $prop]} {
      prop [uplevel #$level subst [lindex $prop 0]] \
           [uplevel #$level subst [lrange $prop 1 end]
    } else {
      append prop "\n"
    }
  }
  foreach prop $props {
    switch -- $prop 
  }
  switch -- $kind {
    wr {}
    rd {}
    upd {}
    out {}
    par {}
  }
}

proc stdConfig::treatArgs {arguments} {
  variable priv undef
  variable type float
  variable nolog
  variable secop_module
  variable cfgcmd [list]
  
  if {[llength $arguments] == 3} {
    # check for new syntax (not yet used?)
    switch -- [lindex $arguments 0] {
      none - int - float - text - drive -
      intar - floatar - intvarar - floatvarar -
      object - func {
        set type [lindex $arguments 0]
        treatProps [lindex $arguments 1] [lindex $arguments 2]
      }
    }
  }
  set opt cfg
  set defpriv internal
  set nolog 0
  set secop_module ""
  foreach a $arguments {
    switch -glob -- $a {
      -internal - -spy - -user - -mugger {
        set priv [string range $a 1 end]
      }
      -none - -int - -float - -text -
      -intar - -floatar - -intvarar - -floatvarar -
      -object - -func - -drive {
        set type [string range $a 1 end]
      }
      -nolog {
        set nolog 1
      }
      -secop=* {
        # clientput "SECOP $a"
        set secop_module [string range $a 7 end]
        # clientput "SECOP $secop_module"
      }
      default {
        switch -- $a {
          wr - out - par {
            set defpriv user
          }
        }
        lappend cfgcmd $a
      }
    }
  }
  if {[string equal undef $priv]} {
    set priv $defpriv
  }
}

proc stdConfig::obj {class args} {
  variable name
  variable base
  variable hostport
  variable makeargs
  variable resolution
  variable ctrl
  variable driver
  variable cfgcmd
  variable priv
  variable type
  variable permanent

  treatArgs $args
  variable objpath $base$name
  variable path $objpath
  variable node $path

  if {! [info exists ctrl]} {
    error "ctrl must be called before obj"
  }
    
#  Layout hdb

  # set path /$name

  if {[string equal drive $type]} {
    hfactory $path plain $priv float
    dynsctdriveobj $name $path $class $ctrl
    hsetprop $path sicscommand "run $name"
  } else {
    dynsicsobj $name $class $priv $type
    hfactory $path link $name
  }
  eval $cfgcmd

  set node $path
  prop objectPath $objpath
  if {$permanent != 1} {
    prop creationCmd "stdConfig::make $driver $name $ctrl $base -port $hostport $makeargs"
  }
  
  set node $path/send
  hfactory $node plain user text
  $ctrl write $node
  prop write stdSct::startSend
  prop complete stdSct::completeSend
  prop visible false
  
  set node $path/status
  hfactory $node plain internal text
  prop visible false
  hupdate $node ""
  logsetup $path/status 1

  if {[string equal drive $type]} {
    set node $path/is_running
    hfactory $node plain user int
    prop visible false
    prop check stdSct::setRunning
    prop write stdSct::complete
    $ctrl write $node
    hupdate $node 0
    logsetup $path/is_running 1

    hsetprop $path updatestatus stdSct::updatestatus_
  }

  set node $path
  switch $type {
    none - func - object {
    }
    default {
      hsetprop $node secop_module $name
      logsetup $node $resolution
    }
  }

  if {$permanent == 0} {
    obj_list makeitem $name $class
    desc_env makeitem $name $class
  }
  return 1
}

proc stdConfig::node {name args} {
  variable objpath
  variable path
  variable ctrl
  variable resolution
  variable cfgcmd
  variable priv
  variable type
  variable nolog
  variable secop_module

  treatArgs $args
  variable node $path/$name
  if {[lindex $cfgcmd 0] eq "alias"} {
    if {[llength $cfgcmd] != 2 || $args ne $cfgcmd} {
      error "Usage: node <node> alias <originalpath>"
    }
    hfactory $node alias [lindex $cfgcmd 1]
  } else {
    hfactory $node plain $priv $type
    if {!$nolog} {
      switch $type {
        float - int {
          hsetprop $node secop_module $secop_module
          logsetup $node $resolution
        }
        text {
          hsetprop $node secop_module $secop_module
          logsetup $node $resolution
          hupdate $node ""
        }
      }
    }
    eval $cfgcmd
  }
  prop objectPath $objpath
}

proc stdConfig::poll {args} {
  variable ctrl
  variable node

  eval [concat $ctrl poll $node $args]
}

proc stdConfig::default {value} {
  variable node
  if {[silent "" hgetpropval $node enum] ne ""} {
    enum_update $node $value
  } else {
    hupdate $node $value
  }
  hdelprop $node geterror
}

proc stdConfig::kids {{title 0} code} {
  variable path
  variable node
  variable name

  if {![string equal hidden $title]} {
    if {[string equal 0 $title]} {
      set title $name
    }
    prop group $title
    prop newline 1
  }
#  if {[silent "" hgetpropval $node __save] eq ""} {
#    prop __save kids
#  }
  set oldpath $path
  set path $node
  if {[catch {uplevel 1 $code} msg]} {
    clientput $msg
  }
  set path $oldpath
}

proc stdConfig::prop {prop args} {
  variable node
  eval [concat hsetprop $node $prop $args]
  if {$prop eq "enum"} {
    eval [concat hsetprop $node enum_ $args]
  }
}

#action scripts

proc stdSct::sync {} {
  set cmd [silent 0 sct synccmd]
  if {[string equal 0 $cmd]} {
    return start
  }
  sct send $cmd
  sct synccnt 10
  return stdSct::syncComplete
}

proc stdSct::syncComplete {} {
  set sr [silent "" sct syncreply]
  if {$sr ne "" && $sr ne [sct result]} {
    sct send "@@NOSEND@@"
  }
  return start
}

proc stdSct::start {} {
  set cmd [silent 0 sct startcmd]
  if {[string equal 0 $cmd]} {
    return unpoll
  }
  sct send $cmd
  return complete
}

proc stdSct::completeStart {} {
  set idn [eval [silent "sct result" sct convert_idn]]
  if {[string equal [sct idn] $idn]} {
    clientput "[sct sicsdev] resynchronized after comm. error"
    return unpoll
  } elseif {[string length [sct idn]] == 0} {
    sct idn $idn
    clientput "connected [sct sicsdev]. idn: [sct idn]"
  } else {
    clientput "[sct sicsdev]: bad answer to startcmd: [sct result]"
    sct idn ""
    return sync
  }
  return unpoll
}

proc stdSct::startSend {} {
  sct send [sct target]
  return complete
}

proc stdSct::completeSend {} {
  sct print "response = [sct result]"
  sct update "[sct target]"
  return idle
}

proc stdSct::errorScript {} {
  set s [split [sct result] :]
  if {[string match *ERR* [lindex $s 0]]} {
    set s [lreplace $s 0 0]
  }
  set s [join $s :]
  [sct controllerName] poll [sct tasksPath] 1 start sync
  error "$s"
}

proc stdSct::read {} {
  sct send [format [sct readcmd] [silent 0 sct addr]]
  return update
}

proc stdSct::scanf {fmt args} {
  set scan [linsert $args 0 scan [sct result] "${fmt}%n"]
  lappend scan _cnt_
  set res [uplevel 1 "eval {$scan}"]
  if {$res != [llength $args] + 1} {
    error "in command:[sct send]\nbad response: [sct result]\nafter arg $res\nfmt=$fmt"
  }
}

proc stdSct::scanresult {} {
  set readfmt [silent 0 sct readfmt]
  if {$readfmt eq "0"} {
    return [sct result]
  }
  stdSct::scanf [sct readfmt] result
  return $result
}

proc stdSct::update {} {
  sct update [stdSct::scanresult]
  return idle
}

proc stdSct::write {} {
  sct send [format [sct writecmd] [sct target] [silent 0 sct addr]]
  return complete
}

proc stdSct::complete args {
  return idle
}

proc stdSct::completeUpdate args {
  catch {
    sct update [sct requested]
  }
  return idle
}

proc stdSct::setRunning args {
  if {[sct target]} {
    error "can not set running - use run command instead"
  }
  [sct controller] queue [sct parent] halt halt
}

# wait for specified time and block controller before starting script
proc stdSct::after {delay script} {
  sct _after_count 10
  [sct controller] poll [sct] [expr $delay * 0.1] start "stdSct::afterpoll $script"
  return idle
}

proc stdSct::afterpoll {script} {
  set cnt [sct _after_count]
  incr cnt -1
  if {$cnt < 0} {
    [sct controller] queue [sct] start $script
    return unpoll
  }
  sct _after_count $cnt
  return idle
}

proc stdSct::updatestatus_ {} {
  set is_running [hval [sct]/is_running]
  set run_status "[sct status] [sct writestatus]"
  if {$run_status ne [silent 0 sct prev_run_status]} {
    hupdate [sct]/is_running [expr {[sct writestatus] eq "start" || [sct status] eq "run"}]
    sct prev_run_status $run_status
  }
}

proc wait_node {path {tmo 30}} {
  set start [clock seconds]
  while {[string length [silent "" hgetpropval $path requested]] != 0} {
    if {[clock seconds] > $start + $tmo} {
      return 1
    }
    wait 0.2
  }
  return 0
}

# return the value of a node, or if a write operation is pending, its requested target
proc sctval {node {default_value 0}} {
  set val [silent $default_value hvali $node]
  return [silent $val hgetpropval $node requested]
}

proc silentval {defval node} {
  set value [hvali $node]  
  catch {
    hgetpropval $node geterror
    set value $defval
  }
  return $value
}

# update error and make logger value invalid
proc updateerror {path error {overwrite 0}} {
  set e [silent 0 hgetpropval $path geterror]
  set val 0
  catch {set val [hvali $path]}
  if {$e eq "0" || $overwrite} {
    hsetprop $path geterror $error
  }
  logsetup $path clear
  hupdate $path $val
}

# update and clear error
proc updateval {path val} {
  hdelprop $path geterror
  hupdate $path $val
}

# update and clear error, clear log when val = undefvalue
proc updateval_u {path val undefvalue} {
  if {$val != $undefvalue} {
    hupdate $path $val
  } else {
    if {[hvali $path] != $undefvalue} {
      hupdate $path $undefvalue
    }
    logsetup $path clear
  }
  hdelprop $path geterror
}

# update and set error when val = undefvalue
proc updateval_e {path val undefvalue error} {
  if {$val != $undefvalue} {
    hupdate $path $val
    hdelprop $path geterror
  } else {
    if {[silent 0 hvali $path] != $undefvalue} {
      hupdate $path $undefvalue
    }
    logsetup $path clear
    hsetprop $path geterror $error
  }
}

proc synceddo {code {timeout 10}} {
  set id [synced begin]
  catch {
    uplevel 1 $code
  }
  synced end $id
  synced wait $id $timeout
}

proc sctsync {code} {
  set id [synced begin]
  uplevel 1 $code
  synced end $id
  sct send $id
}

proc internalset {path value} {
  hsetprop $path internalset 1
  if {[catch {hset $path $value} msg]} {
    hsetprop $path internalset 0
    error $msg
  }
  hsetprop $path internalset 0
}

proc enum_decode {path {input ""} {number_var ""} {name_var ""}} {
  if {$number_var ne ""} {
    upvar $number_var num
  }
  if {$name_var ne ""} {
    upvar $name_var nam
  }

  if {$input eq ""} {
    set input [hvali $path]
  }
  set idx 0
  set enum [split [hgetpropval $path enum] ,]
  if {$enum eq "1"} {
    set enum [list 0 1]
  }
  foreach e $enum {
    lassign [split $e =] name number
    if {$number eq ""} {
      set number $idx
    } else {
      set idx $number
    }
    incr idx
    set match -1
    foreach el $input {
      set tst [expr {$el eq $name || $el eq $number}]
      if {$match < 0} {
        set match $tst
      } elseif {$match != $tst} {
        error "ERROR: $path: $input ambiguous"
      }
    }
    if {$match > 0} {
      set num $number
      set nam $name
      return
    }
  }
  if {$number_var ne ""} {
    set num $input
  }
  if {$name_var ne ""} {
    set nam $input
    clientput "WARNING: enum_decode: ($path) name in '$input' not found"
  }
}

proc named_enum {{textvar ""}} {
  if {$textvar ne ""} {
    enum_decode [sct] [sct target] num nam
    upvar $textvar tv
    set tv $nam
  } else {
    enum_decode [sct] [sct target] num
  }
  sct target $num
  sct requested $num
  return $num
}

proc enum_val {path} {
# for compatibility
  return [hvali $path]
}

proc enum_txt {path} {
  set v [hvali $path]
  enum_decode $path $v num nam
  return $nam
}

proc enum_txt_req {path} {
  set v [hvali $path]
  catch {
    set v [sct requested]
  }
  enum_decode $path $v num nam
  return $nam
}

proc enum_update {args} {
  # one argument: value (on this node)
  # two arguments: path value 
  if {[llength $args] > 2} {
    error {ERROR: Usage: enum_update [path] value}
  }
  if {[llength $args] == 2} {
    set path [lindex $args 0]
    set input [lindex $args 1]
  } else {
    set path ""
    set input $args
  }
  if {$path eq ""} {
    set ownpath 1
    set path [sct]
  } else {
    set ownpath 0
  }
  if {$input eq ""} {
    set input [hvali $path]
  }
  enum_decode $path $input num
  if {$ownpath} {
    sct update $num
  } else {
    hupdate $path $num
  }
  return
}

proc get_values {path args} {
  foreach name $args {
    set varname [regsub "/" $name "_"]
    upvar $varname $varname
    set $varname [expr double([hvali $path/$name])]
  }
}

proc update_values {path args} {
  foreach name $args {
    set varname [regsub "/" $name "_"]
    upvar $varname $varname
    updateval $path/$name [set $varname]
  }
}

# when value on <path> is updated, its gets updated also on the callers node
# older links to callers node are removed

proc link2me {src} {
  catch {
    if {[silent 0 sct link2me] ne $src} {
      [sct controller] updatescript $src "link2me_update [sct]"
      sct link2me $src
      sct update [hvali $src]
    } elseif {[hvali [sct]] ne [hvali $src]} {
      clientlog "link2me [sct]=[hvali [sct]] but $src=[hvali $src]"
    }
  }
}

proc link2me_update {dest value} {
  if {[silent "" hgetpropval $dest link2me] ne [sct]} {
    [sct controller] killupdatescript [sct] "link2me_update $dest"
    clientlog "link removed: [sct] -> $dest"
  } else {
    updateval $dest $value
  }
}

proc on_update_call {src script {valueproperty value}} {
  if {[catch {
    [sct controller] updatescript $src "on_update_queue [sct] $script $valueproperty"
    if {[silent 1 sct on_update_call_cnt] == 0} {
      sct on_update_call_cnt 99
    }
  } msg]} {
    clientput $msg
  }
}

proc on_update_queue {dest script valueproperty value} {
  # when on_update_call_cnt is present on <dest> node:
  #   it is counted down on every call and the script is killed when at 0
  #   in order to keep the script alive, on_update_call_cnt should be set
  #   to a low value in the script itself
  set cnt [silent none hgetpropval $dest on_update_call_cnt] 
  if {$cnt ne "none"} {
    if {$cnt <= 0} {
      [sct controller] killupdatescript $dest "on_update_queue $dest $script $valueproperty"
      return
    }
    hsetprop $dest on_update_call_cnt [expr $cnt - 1]
  }
  hsetprop $dest $valueproperty $value
  [sct controller] queue $dest write $script
}

proc node_cmd args {
  switch [llength $args] {
    0 {
      error "Usage: node_cmd <node> [<name> [<value>]]"
    }
    1 {
      lassign $args node
      return [hval $node]
    }
    2 {
      lassign $args node name
      return [hval $node/$name]
    }
    default {
      set val [lassign $args node name]
      hset $node/$name $val
      return $val
    }
  }
}