sea/tcl/drivers/dilprep.tcl

namespace eval dilprep {
  array set score {dil2 0 dil3 0 dil4 0}
  array set curves {dil2 cx198 dil3 cx262 dil4 cx078}
}


proc stdConfig::dilprep {} {
  controller syncedprot

  obj DILPREP wr
  prop enum warm=0,warmup=1,undef=-1
  default -1
  prop read dilprep::poll
  prop check dilprep::check
  prop write stdSct::complete
  prop buffer ""
  # last time when sample was warm
  prop warmtime 0
  # last time when sample was cold
  prop coldtime 0
  # last time when sample warming up faster than slopelimit
  prop steeptime 0
  # last time when detection was undefined
  prop undeftime [DoubleTime]

  kids dilprep {
    node coldlimit par 280
    prop help "stick is detected cold when T < coldlimit"
    node warmlimit par 290
    prop help "stick is detected warm when T > warmlimit for more than window sec"
    node slopelimit par 0.1
    prop help "stick is detected warm when tslope < slopelimit for more than window sec"
    node window par 600
    prop help "time window (sec)"
    node dil out -int
    prop enum undef=0,dil2=2,dil3=3,dil4=4
    prop check dilprep::checktype
    prop write stdSct::complete
  }
}

proc dilprep::check {} {
  if {[sct target] == 1} {
    # reset slope
    tslope node /ts
  }
  sct update [sct target]
}

proc dilprep::checktype {} {
  variable score
  variable curves

  enum_decode [sct] [sct target] num dilname
  foreach {key value} [array get score] {
    set score($key) 0
  }
  if {$dilname ne "undef"} {
    set score($dilname) 12
  }
  set crv $curves($dilname)
  ts curve $crv
  sct update [sct target]
}

proc dilprep::poll {} {
  variable score
  variable curves

  if {[result _tmon status] eq "no response"} {
    sct connected 0
  } elseif {[silent 1 sct connected] == 0} {
    device name none
    device makeitem action plugged
    device makeitem newdevice dilprep
  }
  set now [DoubleTime]
  set onek [silent 0 result tmon onek/raw]
  set stillt [silent 0 result tmon stillt/raw]
  set mix [silent 0 result tmon mix/raw]
  if {$onek * $stillt * $mix == 0} {
    sct update -1
    return idle
  }
  # guess dilution type from typical resistivities
  # determine possible candidate
  set dilname undef
  if {abs($mix - 2200) < 50 && abs($onek - 2260) < 100 && abs($stillt - 2260) < 100} {
    if {$onek > 2260} {
      if {$stillt > 2260} {
        set dilname dil4
      }
    } elseif {$stillt < 2260} {
      set dilname dil2
    } else {
      set dilname dil3
    }
  }
  set maxscore 0
  # increase score for matching candidate, decrease for others (clamped within 0..12)
  foreach {key value} [array get score] {
    if {$key eq $dilname} {
      set value [expr min(12, $value + 1)]
    } else {
      set value [expr max(0, $value - 1)]
    }
    if {$value > $maxscore} {
      set maxscore $value
    }
    set score($key) $value
  }
  if {$dilname eq "undef"} {
    sct undeftime $now
    return idle
  }
  if {$maxscore eq 0} {
    # no max score
    enum_update [sct]/dil undef
  } elseif {$score($dilname) >= $maxscore} {
    if {$dilname ne [enum_txt [sct]/dil]} {
      clientput "detected $dilname"
      # highest score for $dilname
      enum_update [sct]/dil $dilname
      set crv $curves($dilname)
      ts curve $crv
    }
  }
  set mode [sctval [sct]]
  set lim [hval [sct]/warmlimit]
  set ts [silent 0 result ts]
  set window [hval [sct]/window]
  if {$mode == 1} {
    # warming up
    if {$ts < $lim} {
      sct coldtime $now
    }
    if {[silent 999 hval /tslope] > [hval [sct]/slopelimit]} {
      sct steeptime $now
    }
    if {$now > min([sct steeptime], [sct coldtime]) + $window} {
      # warm
      if {[sct steeptime] < [sct coldtime]} {
        clientput "stick is warm (slope < [hval [sct]/slopelimit] for more than $window sec)"
      } else {
        clientput "stick is warm (T > [hval [sct]/warmlimit] for more than $window sec)"
      }
      sct target 0
      check
      return idle
    }
  } elseif {$mode < 0} {
    # undef
    if {$ts != 0} {
      if {$now > [sct undeftime] + 120} {
        if {$ts > [hval [sct]/warmlimit]} {
          set mode 0
          clientput "stick is warm"
        } else {
          set mode 1
          clientput "stick is warming up"
        }
      }
      sct target $mode
      check
      return idle
    }
  } else {
    # warm or undef
    if {$ts > [hval [sct]/coldlimit]} {
      sct warmtime $now
    }
    if {[hval [sct]/dil] != 0 && $now > [sct warmtime] + $window} {
      # warmup
      sct target 1
      check
      return idle
    }
  }
  sct update $mode
  return idle
}