namespace eval mom {
}

if {![namespace exists lsc]} {
  source drivers/lsc.tcl
}

# multichannel ohm meter with innovative self heat- and thermo-electric adjustment
proc stdConfig::mom_sensor args {
  variable mom_cfg
  variable mom_color
  variable name
  variable path
  
  scanargs $args var -channel -label -curve 0 -adjust 0 -color 0
  if {![info exists mom_cfg($channel)]} {
    error "illegal MOM channel: $channel"
  }
  set mom_cfg($channel) 1
  if {$color eq "0"} {
    set color $mom_color
    incr mom_color
  }
  node $channel upd
  prop v0 0
  if {$label eq "0"} {
    set enable 0
  } else {
    set enable 1
    if {$curve eq "0"} {
      set unit Ohm
    } else {
      set unit K_2
    }
    GraphAdd ${name}.${channel} $unit $label $color
  }
  kids "$label settings" {

    node enable par $enable
    prop enum 1

    node r upd

    node curve out -text
    prop width 32
    prop model 0
    prop check mom::curve
    prop write stdSct::completeUpdate

    kids "calibration" {
      node adjust out -text
      default 0
      prop width 32
      prop check mom::adjust
      prop write stdSct::completeUpdate
      hfactory $path/points plain mugger floatvarar 1
      hfactory $path/cpoints plain mugger floatvarar 1
    }   
  }
  hupdate $path/$channel/curve/adjust $adjust
  hset $path/$channel/curve $curve
}

proc stdConfig::mom {cfgscript} {
  variable name
  variable node
  variable path
  variable mom_cfg
  variable mom_color
  
  if {[controller std "\r" 2]} {
    controllerDesc "MOM controller"
  }

  pollperiod 5
  obj mom rd
  prop read mom::read
  prop extmax 7
  prop extidx -1
  
  array set mom_cfg {ta 0 tb 0 tc 0 td 0 ref 0}
  foreach ch [array names mom_cfg] {
    set mom_cfg($ch) 0
  }
  set mom_color 11
  
  kids hidden {
    node excitation out
    default 100
    prop check mom::checkexcit
    prop write stdSct::completeUpdate

    if {[catch $cfgscript msg]} {
      clientput $msg
    }
    foreach ch [array names mom_cfg] {
      if {!$mom_cfg($ch)} {
        mom_sensor $ch 0
      }
    }

    node ext upd    
    prop v0 0
    node com upd
    prop v0 0
    node gnd upd
    prop v0 0
  }
  return "MOM multichannel ohm meter"
}

proc mom::start {} {
# set adc rate to 11
  sct send ":10000D000102000B.."
  return mom::start2
}

proc mom::start2 {} {
# set all i/o to output / push-pull / low
  sct send ":10000000030600FF00FF0000.."
  return mom::getidn
}

proc mom::getidn {} {
  sct send ":0300030001.."
  return stdSct::completeStart
}

proc mom::read {} {
  sct send ":0400000008.."
  return mom::update
}


proc mom::adjustcurve {} {
  set adjust [sctval [sct]/adjust]
  set points [sctval [sct]/points]
  if {$adjust ne "0"} {
#    if {[llength $adjust] == 2} {
#      set radj [list 0 0]
#    } else {
      set radj [list]
#    }
    foreach {r t} $adjust {
      lappend radj [interpolate $points 1 $t logx logy extrapolate] $r
    }
#clientput "ADJUST $radj"
    set cpoints [list]
    foreach {r t} $points {
#if {abs($t - 77) < 20} {
#  clientput "T $t R $r R [interpolate $radj 0 $r 1.0]"
#}
      lappend cpoints [interpolate $radj 0 $r 1.0] $t
    }
    hupdate [sct]/cpoints $cpoints
  } else {
    hupdate [sct]/cpoints $points
  }
}

proc mom::curve {} {
  if {[sct requested] ne "0"} {
    lsc::read_curve
    mom::adjustcurve
  }
}

proc mom::adjust {} {
  hset [sct parent] [sctval [sct parent]]
}

proc mom::toKelvin {r channel} {
  set t [interpolate [hvali [sct]/$channel/curve/cpoints] 0 $r logx logy extrapolate]
  return $t
}

proc mom::toOhm {t channel} {
  set r [interpolate [hvali [sct]/$channel/curve/cpoints] 1 $t logx logy extrapolate]
  return $r
}

proc mom::update {} {
  if {[scan [sct result] ":0410%4x%4x%4x%4x%4x%4x%4x%4x" gnd ref com ext ta tb tc td] != 8} {
    error "bad response to '[sct send]': '[sct result]'"
  }
  set extidx [sct extidx]
#  clientput "$extidx gnd $gnd ref $ref com $com ext $ext r $ta $tb $tc $td" 

#<<< debug
#  if {$extidx > 0} {
#    incr extidx -1
#  } else {
#    set extidx 13
#  }
#  if {0==1} {
#>>>

  sct update $extidx
  set excitation [expr [hvali [sct]/excitation]*65535./2500.]
  if {$extidx <= 0} {
    foreach channel {gnd com ext} {
      sct ${channel}0 [set $channel]
#     clientput "$channel zero [set $channel]"
    }
    foreach channel {ref ta tb tc td} {
      if {[silent 0 hgetpropval [sct]/$channel emx] == 0} {
        updateerror [sct]/$channel undefined
        updateerror [sct]/$channel/r undefined
      }
      set vi [set $channel]
      hsetprop [sct]/$channel v0 $vi
#     clientput "${channel}0 $vi"
      hsetprop [sct]/$channel emx 0
    }
    if {$extidx < 0} {
      incr extidx
    } else {
      set extidx [sct extmax]
    }
#clientput "new extidx $extidx"
  } else {
    sct gnd$extidx $gnd
    set com [expr $com - [sct com0]]
    sct com$extidx $com
    set ext [expr $ext - [sct ext0] - $com]
    if {$ext <= 0} {
      set ext 1
    }
    sct ext$extidx $ext
    set minvi 99999
    set done 1
    foreach channel {ref ta tb tc td} {
      set vi [expr [set $channel] - [hgetpropval [sct]/$channel v0] - $com]
      hsetprop [sct]/$channel v$extidx $vi
      set vilim [expr $ext / (1.0 + 2./100.)]
# clientput "ext $ext $channel $vi < lim $vilim"
      if {[hvali [sct]/$channel/enable] && $vi < $vilim} {
# resistivity < 100kOhm
        set r [expr 2000.0*$vi/($ext - $vi)]
        if {$vi <= 0 && $extidx > 0} {
          # mom has been reset: restart
          sct extidx -1
          return idle
        }
# clientput "$channel ( $extidx ) $excitation $vi $ext r=$r"
        if {$vi < $minvi} {
          set minvi $vi
        }
        if {$vi >= $excitation || $extidx == 13} {
#clientput "$extidx e13"
          set done 0
          hsetprop [sct]/$channel emx $extidx
          hsetprop [sct]/$channel vmx $vi
          hsetprop [sct]/$channel rmx $r
          if {$extidx == 1} {
            hupdate [sct]/$channel/r $r
            set temp [mom::toKelvin $r $channel]
          }
        } else {
          if {$extidx+1 == [silent 0 hgetpropval [sct]/$channel emx]} {
            if {[hvali [sct]/$channel/curve] ne "0"} {
              set vmx [hgetpropval [sct]/$channel vmx]
              set rmx [hgetpropval [sct]/$channel rmx]
              if {$rmx <= 0} {
                clientput "rmx $rmx vmx $vmx"
                set rmx 200
                set vmx [expr 2 * $vi]
              }
              set w [expr ($excitation - $vi) / ($vmx - $vi)]
              if {$w > 1} {
                set w 1
              } elseif {$w < 0} {
                set w 0
              }
              set tmx [mom::toKelvin $rmx $channel]
              hsetprop [sct]/$channel tmx $tmx
              set tmn [mom::toKelvin $r $channel]
              if {[silent 0 sct disablesh] == 0} {
                # self heat calc (K/uW) (687.17 = 65535/2500 ^ 2):
                set sh [expr ($tmx - $tmn) * 687.17 / ($vmx * $vmx / $rmx - $vi * $vi / $r)]
                set sh0 [silent 0 hgetpropval [sct]/$channel selfheatcoef]
                if {$sh0 != 0} {
                  set sh [expr $sh0 * 0.9 + $sh * 0.1] 
                }
              } else {
                set sh 0
              }
              hsetprop [sct]/$channel selfheatcoef $sh
              if {$sh < 0} {
                set sh 0
              }
            
              set t0 [mom::toKelvin $r $channel]
              set t [expr $w * ($tmx - $sh * $vmx * $vmx / $rmx / 687.17) \
                      + (1 - $w) * ($t0 - $sh * $vi * $vi / $r / 687.17)]
              set r [mom::toOhm $t $channel]
              hsetprop [sct]/$channel selfheatcorr [expr $t0 - $t]
            } else {
              set t $r
            }
            updateval [sct]/$channel $t
            updateval [sct]/$channel/r $r
           }
        }
      }
    }
    if {$minvi < 99999} {
      if {$minvi < $excitation && $extidx == [sct extmax] && $extidx < 13} {
#        clientput INCREASE
        while {$extidx < 13 && $minvi < $excitation} {
          incr extidx
          set minvi [expr $minvi * 1.6]
        }
        sct extmax $extidx
      } else {
        if {$done} {
#          clientput END
          set extidx 0
        } else {
#          clientput DOWN
          if {$extidx > 1 && [sct extmax] > $extidx && $minvi >= $excitation} {
#            clientput "REDUCE $extidx"
            sct extmax $extidx
          }
          incr extidx -1
        }
      }
    }
  }
#}  
  set extidx [silent $extidx sct fixedext]
  sct extidx $extidx
  if {$extidx < 0} {
    set extcode 0
  } else {
    set extlist {0 1 2 3 4 7 8 15 16 31 36 63 71 127}
    if {$extidx >= [llength $extlist]} {
      set extcode 0
    } else {
      set extcode [lindex $extlist $extidx]
    }
  }
  sct send [format ":10000000030600FF00FF00%2.2X.." $extcode]
  return stdSct::complete
}

proc mom::calib {obj channel r1 t1 r2 t2} {
  set rn1 [expr exp(pow($t1,-0.731)*7.03)]
  set rn2 [expr exp(pow($t2,-0.731)*7.03)]
  if {$t1 > 85 || $t2 > 85} {
    clientput "not precise for T > 85"
  } 
  set r0 [expr ($r2-$r1)/($rn2-$rn1)]
  set offset [expr $r1 - $r0 * $rn1]
  $obj $channel/r0 $r0
  $obj $channel/offset $offset
  return "r0 $r0 offset $offset"
}


proc mom::checkexcit {} {
  catch {hsetprop [sct parent]/ta selfheatcoef 0}
  catch {hsetprop [sct parent]/tb selfheatcoef 0}
  catch {hsetprop [sct parent]/tc selfheatcoef 0}
  catch {hsetprop [sct parent]/td selfheatcoef 0}
  catch {hsetprop [sct parent]/ref selfheatcoef 0}
}

publishLazy mom::calib
