#!/usr/bin/wish -f
#
# Hot Little Therm controller v1
# Reed C. Wade
# Robert Manchek
#
# $Id: hltw1.tcl,v 1.33 1999/12/09 03:40:56 manchek Exp $
# $Log: hltw1.tcl,v $
# Revision 1.33  1999/12/09 03:40:56  manchek
# don't error fatally when can't read serial port.
# show color markers for probe legend and current temps
#
# Revision 1.32  1998/11/17 01:10:54  manchek
# added retry capability when reading probes in case there's a glitch.
# added sanity checking of the syntax of the reply "Txxx ...".
# added retry setting and error counters to setup screen
#
# Revision 1.31  1998/10/14 23:51:13  manchek
# wrapped menu popup ops in catch because sometimes tk...Focus fails?
#
# Revision 1.30  1998/10/11 23:43:16  manchek
# updated help text
#
# Revision 1.29  1998/10/11 23:40:31  manchek
# in updateView, expire samples older than PERIOD*BUFFER
#
# Revision 1.28  1998/10/10 15:20:43  manchek
# in readLog wrapped seek from end in catch because it can fail
#
# Revision 1.27  1998/10/10 15:03:13  manchek
# added 2 and 5 minute ranges, adjusted setup defaults
#
# Revision 1.26  1998/10/10 14:53:11  manchek
# commentation and some cleanup
#
# Revision 1.25  1998/10/10 14:03:22  manchek
# removed "global"s from config file format - they're declared
# explicitly in loadConfig to avoid importing relics
#
# Revision 1.24  1998/10/10 13:59:04  manchek
# added "re-read log file at startup" setup option.
# broke setPlotRange into 2 functions
#
# Revision 1.23  1998/10/10 13:44:12  manchek
# made HTTP port configurable (and turnoffable) via the setup screen.
# updated the help text
#
# Revision 1.22  1998/10/10 13:15:46  manchek
# force graph redraw on exit from general or probes setups.
# made http server safe from client-side disconnect by wrapping
# it in a catch.
#
# Revision 1.21  1998/10/09 23:53:17  manchek
# clip time tick lines to max buffer date in updateView
#
# Revision 1.20  1998/10/09 23:33:45  manchek
# added seek-tail to readLog, now it's fast enough to use
#
# Revision 1.19  1998/10/09 23:13:56  manchek
# added "oldestTime" comparison to readLog and updateView
#
# Revision 1.18  1998/10/09 06:36:03  manchek
# added readLog function to re-read log at startup.
# still unfinished, need to limit age and number of samples read in.
# store plot RANGE in config file so it's persistent.
# plot needs work, to avoid drawing lines off the screen.
# tempList(Txxx timestamp) array needs redesign, too inefficient
#
# Revision 1.17  1998/10/09 05:01:49  manchek
# added time scale button for graph.
# improved graph drawing - now is at right and time/x distance is constant.
# improved accuracy of timer, subtracting time taken to perform update
#  from next-update timer
#
# Revision 1.16  1998/10/08 23:13:15  manchek
# changed help version string to RCS id
#
# Revision 1.15  1998/10/08 23:09:57  manchek
# made loadConfig more robust, required settings get defaults
# even if they're not in the config file.
# moved default values to end of script
#
# Revision 1.14  1998/09/03 05:21:38  manchek
# added button to clear log file selection
#
# Revision 1.13  1998/09/03 04:32:37  manchek
# changed version to v1B.
# removed t2, t3 debug labels from graph.
# updated help text
#
# Revision 1.12  1998/09/03 04:10:53  manchek
# when reading config file, for each probe in activeProbe list,
# touch its entries in other lists (color, name, ...) so they
# exist for use later.
#
# Revision 1.11  1998/09/03 03:58:27  manchek
# made alarm text window scroll to end on update
#
# Revision 1.10  1998/09/03 03:54:51  manchek
# changed "busy" lite background to grey
#
# Revision 1.9  1998/09/03 03:50:47  manchek
# changed log file data format to "YYYY/mm/dd hh:mm:ss"
#
# Revision 1.8  1998/09/03 03:48:02  manchek
# added per-probe "alarm" checkbutton and lo/hi temp limits.
# added alarm popup widget to log error conditions.
# check every probe poll for missing probes or out of lo/hi range
#
# Revision 1.7  1998/09/03 02:57:26  manchek
# check activeProbe() exists before using it in proc updateView.
# this caused crash if new (unconfigured) probes found
#
# Revision 1.6  1998/05/21 01:28:06  manchek
# disabled log-file-name entry widget in setups (no typing into it)
#
# Revision 1.5  1998/05/20 05:00:11  manchek
# merged windows changes back in, switching on tcl_platform(platform)
#
# Revision 1.4  1998/05/20 04:39:50  manchek
# added C/F units display and log option
#
# Revision 1.3  1998/05/20 03:58:39  manchek
# changed help text
#
# Revision 1.2  1998/05/20 03:38:50  manchek
# minimal changes to work on linux
#
# Revision 1.1  1998/05/20 03:29:34  manchek
# Initial revision
#
#

option add "*background" "#cba"
option add "*activeBackground" "#dcb"

set ver {$Id: hltw1.tcl,v 1.33 1999/12/09 03:40:56 manchek Exp $}
set ver [lrange $ver 1 3]

wm title . "HLTWare $ver"
wm geom . 500x400

# set up main screen

frame .main
pack .main -fill both -expand 1
set head .main.head
frame $head
set body .main.body
frame $body
set foot .main.foot
frame $foot

pack $head -side top -fill x -expand 0
pack $body -fill both -expand 1
pack $foot

# set up header buttons

button $head.setup -text "Setup Options..." -command openSetup
button $head.probes -text "Setup Probes..." -command openProbes
button $head.alarm -text "Show Alarms" -command "logAlarm {}"
button $head.help -text Help -command "showHelp main"
button $head.quit -text Exit -command quit
pack $head.setup $head.probes $head.alarm $head.help $head.quit -side left -fill x -padx 1m

frame $body.fc
canvas $body.fc.c -relief ridge -bd 2
pack $body.fc -expand 1 -fill both

frame $body.fc.s
set Canvas $body.fc.c
pack $body.fc.c -side right -expand 1 -fill both
pack $body.fc.s -side left -expand 0 -fill y

label $body.fc.s.lite -text "busy"
set Lite $body.fc.s.lite
$Lite configure -fg [$Lite cget -bg]
pack $body.fc.s.lite -side top -fill x

set ScaleButton $foot.scale
button $ScaleButton -text "XXX" -command plotRangeMenu
pack $ScaleButton

#
# open the menu of plot time ranges
#
proc plotRangeMenu {} {
    global Times TimeText RANGE
    catch {destroy .prm}
    menu .prm -tearoff false
    set j 0
    set k 0
    foreach i $Times {
	.prm add command -label $TimeText($i) -command "setPlotRangeMenuCmd $i ; updateView"
	if {$RANGE == $i} {
	    set j $k
	}
	incr k
    }
    catch {tk_popup .prm [winfo pointerx .] [winfo pointery .] $j}
}

#
# menu action to select a new plot range
# and save the configuration
#
proc setPlotRangeMenuCmd {sec} {
    setPlotRange $sec
    destroy .prm
    saveConfig
}

#
# set plot range
#
proc setPlotRange {sec} {
    global ScaleButton RANGE
    $ScaleButton configure -text [getTimeText $sec]
    set RANGE $sec
}

proc setupCanvas {} {
  global probeList unitList numUnits numProbes
  global activeProbe
  global Canvas 

  $Canvas delete all

  if {[array size activeProbe] < 1} {
    $Canvas create text 20 20 -text "No active probes defined." -anchor nw
    bind $Canvas <1>
  } else {
    bind $Canvas <1> pollUpdate
  }
  bind $Canvas <Configure> updateView
}

#
# set "busy" light to on or off state
#
proc lights {state} {
  global Canvas Lite
  if {$state} {
    $Lite configure -foreground red
  } else {
    $Lite configure -fg [$Lite cget -bg]
  }
  update idletasks
}

#
# do processing for poll timer tick
# 
proc pollUpdate {} {
  readTherms
  checkAlarms
  writeLog
  updateView
}

#
# append a new entry to the temp log file.
# if the file was empty, also write a header line with the probe names
#
proc writeLog {} {
  global LOGFILE
  global temperature tempLast activeProbe nameProbe

  if {[array size activeProbe] == 0} {
    return;
  }

  if {[string length $LOGFILE] != 0} {
    set a [open $LOGFILE a+]

    if {[tell $a] == 0} {
      puts -nonewline $a {"time"}
      foreach i [lsort [array names activeProbe T*]] {
        set n $nameProbe($i)
        if {$activeProbe($i)} {
          puts -nonewline $a ",\"$n\""
        }
      }
      puts $a ""
    }

    puts -nonewline $a "\"[formatDate $tempLast]\""

    foreach i [lsort [array names activeProbe T*]] {
      if {$activeProbe($i)} {
        if {[catch "set t [CtoAny $temperature($i)]"]} {
          set t ""
        }
        puts -nonewline $a ",\"$t\""
      }
    }

    puts $a ""
    close $a
  }
}

#
# read the tail end of the temp log file back into buffers.
#
proc readLog {} {
  global LOGFILE
  global temperature tempList activeProbe nameProbe
  global startTime PERIOD BUFFER

  if {[array size activeProbe] == 0} {
    return;
  }
  if {[string length $LOGFILE] == 0} {
    return;
  }
  if {[catch {set ff [open $LOGFILE r]}]} {
    return;
  }

  #
  # compare probe names in log file against active probes
  #
  gets $ff fprobes
  set aprobes {"time"}
  foreach i [lsort [array names activeProbe T*]] {
    append aprobes {,"} $nameProbe($i) {"}
  }
  if {$aprobes != $fprobes} {
    logAlarm "Warning: Probe names in log file $LOGFILE don't match active probes"
    close $ff
    return;
  }

  #
  # read approx last BUFFER lines of file, as long as timestamps
  # are between oldestTime and now
  #
  # seek into the file to tail it, since reading the whole thing
  # would be way too slow.
  # (this assumes all lines are the same length)
  #
  set filesiz [file size $LOGFILE]
  if {$filesiz > 10000} {
    # read a few lines to get average line length
    set linelen 0
    for {set f 0} {$f < 10} {incr f} {
      seek $ff [expr ($filesiz*$f)/10]
      gets $ff a
      gets $ff a
      incr linelen [expr [string length $a] +1]
    }
    set s [expr -int($linelen/10.0*$BUFFER)]
    if {$s < 0} {
	catch {seek $ff $s end}
	gets $ff a
    }
    gets $ff a
  }

  set oldestTime [expr $startTime-$PERIOD*$BUFFER]
  set aprobes [lsort [array names activeProbe T*]]
  while {[gets $ff a] > 0} {
    set w [split $a {"/ }]
    set d [format "%s/%s/%s %s" \
      [lindex $w 2] [lindex $w 3] [lindex $w 1] [lindex $w 4]]
    set t [clock scan $d]
    if {$t >= $oldestTime} {
      set w [lrange [split $a ","] 1 end]
      for {set i [expr [llength $w]-1]} {$i >= 0} {incr i -1} {
        set v [lindex $aprobes $i]
        append v " $t"
        set tempList($v) [AnyToC [string trim [lindex $w $i] {"}]]
      }
    }
  }
  close $ff
}

#
# redraw everything in the temp plot canvas.
#
# also, expire buffered samples older than PERIOD*BUFFER
# (this is easier than counting the number of samples per head)
#
proc updateView {} {
  global probeList unitList numUnits numProbes
  global activeProbe nameProbe temperature jumper
  global Canvas Scrollbar
  global tempList tempLast startTime colorProbe
  global CanvasPageSize CanvasPointSize
  global RANGE PERIOD BUFFER

  set cHigh [winfo height $Canvas]
  set cWide [winfo width $Canvas]

  set trueWidth $RANGE
  set oldestTime [expr $tempLast-$trueWidth]
  set expireTime [expr $tempLast-$PERIOD*$BUFFER]

  $Canvas delete all

  # buffer limit mark
  set bufferOldest [expr $tempLast-$PERIOD*$BUFFER]
  set oldestX [expr $cWide-1-($tempLast-$bufferOldest)*$cWide/$trueWidth]
  if {$oldestX > 0} {
    $Canvas create line $oldestX 0 $oldestX $cHigh -fill white -width 3
  }

  # zero scale
  set z [yXform $cHigh 0]
  $Canvas create line 0 $z $cWide $z -fill white

  # time scale lines - display minute, hour or day scale
  set s 0
  if {($trueWidth > 70) && ($trueWidth <= 1800)} {
    set s 60
  } elseif {$trueWidth > 3600 && $trueWidth <= 86400} {
    set s 3600
  } else {
    set s 86400
  }
  if {$s > 0} {
    for {set sx $s} {$sx < $trueWidth} {incr sx $s} {
      set x [expr $sx*$cWide/$trueWidth]
      if {$x > $oldestX} {
        $Canvas create line $x 0 $x $cHigh \
	  -fill white
      }
    }
  }

  # text - current temp of each probe
  set y 30
  foreach i [array names activeProbe T*] {
    if {$activeProbe($i)} {
      if {[catch "set t [CtoAny $temperature($i)]" ]} {
        set t "??"
      }
      $Canvas create text 50 $y -text "$nameProbe($i) = $t" -anchor w
      $Canvas create rectangle 40 [expr $y - 3] 45 [expr $y + 2] -fill $colorProbe($i)
      incr y 20
    }
  }

  foreach i {100 80 60 40 20 0 -20 -40} {
    $Canvas create text 5 [yXform $cHigh $i] -text $i -anchor w
  }
  $Canvas create text 10 10 -text [format "Last sample: %s" [clock format $tempLast]] -anchor w
# $Canvas create text [expr $cWide -10] 10 \
#	-text "Run time: [dhms [expr ($tempLast-$startTime)]]" \
#	-anchor ne

  # create the lines for each probe
  # make list of to-be-expired samples
  update
  update idletasks
  set toExpire {}
  foreach i [lsort [array names tempList]] {
    set p [lindex $i 0]
    if {[info exists activeProbe($p)]} {
      if {$activeProbe($p)} {
	set t [lindex $i 1]
	if {$t <= $expireTime} {
	  lappend toExpire $i
	} elseif {$t >= $oldestTime} {
          set x [expr $cWide-1-($tempLast-$t)*$cWide/$trueWidth]
          set y [yXform $cHigh [CtoAny $tempList($i)] ]
          append linelist($p) " $x $y"
	}
      }
    }
  }
  update
  update idletasks
  foreach i [array names activeProbe T*] {
    if {$activeProbe($i) && ![catch "set linelist($i)"]} {
      if {[llength $linelist($i)] > 2} {
        eval $Canvas create line $linelist($i) \
		-fill $colorProbe($i) -width 2
      }
      if {[info exists temperature($i)]} {
	set x [expr $cWide-1]
	set y [yXform $cHigh [CtoAny $temperature($i)] ]
	$Canvas create rectangle [expr $x - 5] [expr $y - 3] $x [expr $y + 2] -fill $colorProbe($i)
      }
    }
  }
  update
  update idletasks

  # expire old samples
  foreach i $toExpire {
    unset tempList($i)
  }
}

#
# given seconds, display hh:mm:ss
#
proc hms {s} {
  set a [clock format $s -format "%M:%S"]
  set s [expr int($s/(60*60))]
  return "$s:$a"
}

#
# given seconds, display [d+]hh:mm:ss
#
proc dhms {s} {
  set d [expr int($s/86400)]
  set h [expr int($s/3600)%24]
  set m [expr int($s/60)%60]
  set s [expr $s % 60]
  return [format "%d+%02d:%02d:%02d" $d $h $m $s]
}

#
# do y transform for temperature value into canvas.
#
# cHigh is the height in pixels of the window
# t is the temperature
# we return the y pixel location
# there are 180 degrees in C from top to bottom (+125 to -55)
#
proc yXform {cHigh t} {
  set scale [expr $cHigh/180.0]
  set t [expr -$t]
  set t [expr $t +125]
  set t [expr $t *$scale]
  return $t
}

#
# read temperatures from all connected therm devices
#
proc readTherms {} {
  global temperature portFP numUnits jumper COMMPORT
  global tempList tempLast activeProbe READRETRY errorCount
  catch "unset temperature"
  catch "unset jumper"

  set tempLast [clock seconds]

  lights 1
  if {[info exists portFP]} {
    # flush anything on the wire
    read $portFP

    for {set i 0} {$i<$numUnits} {incr i} {
      for {set try $READRETRY} {$try > 0} {incr try -1} {
        puts -nonewline $portFP [binary format c [expr $i+16]]
        after 200 ; update ; update idletasks 
        after 200 ; update ; update idletasks 
        after 200 ; update ; update idletasks 
        after 200 ; update ; update idletasks 
        after 200 ; update ; update idletasks 

        set A ""
        while {[string length [set a [read $portFP]]]} {
          append A $a
          after 200
          update idletasks
          update 
        }

        set u xxx
        foreach a [split $A "\n"] {
          if {"T" == [string index $a 0]} then {
            set a [string trim $a]
            set A [lindex $a 0]
            set B [lindex $a 1]
            if {[string match "T????????????????" "$A"] && [regexp {^[+-]?[0-9]+(\.[0-9]+)?$} "$B"]} {
              set temperature($A) $B
              append A " $tempLast"
              set tempList($A) $B
            }
          } elseif {"S" == [string index $a 0]} then {
            set jumper($u) [string index $a 1]
          } elseif {"V" == [string index $a 0]} then {
            set a [string trim $a]
            set u $a
          }
        }

        set tryAgain 0
#puts [array names activeProbe T*]
        foreach j [array names activeProbe T*] {
          if {![info exists temperature($j)]} {
#puts $j
            set tryAgain 1
          } else {
          }
        }
        if {$tryAgain} {incr errorCount} {set try 0}
      }
    }
  } else {
    logAlarm "Can't open serial port $COMMPORT"
  }
  lights 0
}

#
# check that temperatures are within limits for all probes
# that have alarms enabled.
#
proc checkAlarms args {
  global activeProbe alarmProbe aloProbe ahiProbe nameProbe temperature tempLast
  set once 1
  foreach i [array names activeProbe T*] {
    if {$activeProbe($i)} {
      if {[catch "set t [CtoAny $temperature($i)]" ]} {
        if {$once} {
          set once 0
          logAlarm [formatDate $tempLast]
        }
        logAlarm "CAN'T READ: $nameProbe($i) temperature"
      } else {
        if {$alarmProbe($i)} {
          if {$t <= $aloProbe($i)} {
            if {$once} {
              set once 0
              logAlarm [formatDate $tempLast]
            }
            logAlarm "UNDERTEMP: $nameProbe($i): $t degrees"
	  }
          if {$t >= $ahiProbe($i)} {
            if {$once} {
              set once 0
              logAlarm [formatDate $tempLast]
            }
            logAlarm "OVERTEMP: $nameProbe($i): $t degrees"
	  }
        }
      }
    }
  }
}

#
# open the "Setup Options" dialog.
#
proc openSetup {} {
  set s ".setup"
  catch "destroy $s"

  global PERIOD BUFFER COMMPORT LOGFILE DUNITS HTTPPORT REREADLOG
  global tempDUNITS READRETRY
  global flag errorCount

  toplevel $s
  wm title $s "Setup Options..."

  frame $s.f1
  frame $s.f2
  frame $s.f3
  frame $s.f6
  frame $s.f4
  frame $s.f5
  frame $s.f8
  frame $s.f7
  frame $s.f9
  pack $s.f1 $s.f2 $s.f3 $s.f6 $s.f5 $s.f8 $s.f7 $s.f9 $s.f4 -side top -fill x -expand 1 \
    -padx 1m -pady 1m

  label $s.f1.lPort -text "Serial Port:"
  entry $s.f1.ePort 
  $s.f1.ePort insert 0 $COMMPORT
  pack $s.f1.lPort $s.f1.ePort -side left

  label $s.f2.lDir -text "Log File:"
  entry $s.f2.eDir -width 30
  $s.f2.eDir insert 0 $LOGFILE
  $s.f2.eDir configure -state disabled
  button $s.f2.bDir -text "Browse..." -command \
    "dataDirBrowse $s $s.f2.eDir"
  button $s.f2.bClr -text "Clear" -command \
    "set LOGFILE {} ; $s.f2.eDir configure -state normal ; $s.f2.eDir delete 0 end ; $s.f2.eDir configure -state disabled"
  pack $s.f2.lDir $s.f2.eDir $s.f2.bDir $s.f2.bClr -side left

  label $s.f3.lPeriod -text "Sample period (seconds):"
  entry $s.f3.ePeriod -width 6
  $s.f3.ePeriod insert 0 $PERIOD
  pack $s.f3.lPeriod $s.f3.ePeriod -side left

  label $s.f6.lBuffer -text "Buffer (number of samples):"
  entry $s.f6.eBuffer -width 6
  $s.f6.eBuffer insert 0 $BUFFER
  pack $s.f6.lBuffer $s.f6.eBuffer -side left

  label $s.f5.lUnits -text "Display and Log Units:"
  radiobutton $s.f5.eUnitsC -text "C" -variable tempDUNITS -value "C"
  radiobutton $s.f5.eUnitsF -text "F" -variable tempDUNITS -value "F"
  set tempDUNITS $DUNITS
  pack $s.f5.lUnits $s.f5.eUnitsC $s.f5.eUnitsF -side left

  label $s.f8.lReread -text "Reread log file at startup:"
  radiobutton $s.f8.eRereadY -text "Y" -variable REREADLOG -value "Y"
  radiobutton $s.f8.eRereadN -text "N" -variable REREADLOG -value "N"
  pack $s.f8.lReread $s.f8.eRereadY $s.f8.eRereadN -side left

  label $s.f7.lPort -text "HTTP server port (0 to disable):"
  entry $s.f7.ePort -width 6
  $s.f7.ePort insert 0 $HTTPPORT
  pack $s.f7.lPort $s.f7.ePort -side left

  label $s.f9.lRetry -text "Number of read retries:"
  entry $s.f9.eRetry -width 6
  $s.f9.eRetry insert 0 $READRETRY
  label $s.f9.lErrs -text "Device Read Errors="
  entry $s.f9.eErrs -width 10
  $s.f9.eErrs insert 0 $errorCount
  $s.f9.eErrs configure -state disabled
  button $s.f9.bErrs -text "reset" -command "set errorCount 0 ;$s.f9.eErrs configure -state normal ;$s.f9.eErrs delete 0 end ;$s.f9.eErrs insert 0 0 ;$s.f9.eErrs configure -state disabled"
  pack $s.f9.lRetry $s.f9.eRetry $s.f9.lErrs $s.f9.eErrs $s.f9.bErrs -side left

  button $s.f4.ok -text "Ok" -command \
	"set flag ok ; destroy $s.f4.ok"
  button $s.f4.cancel -text "Cancel" -command \
	"set flag cancel ; destroy $s.f4.ok"
#  button $s.f4.help -text "Help" -command \
#	 "showHelp setup"
#  pack $s.f4.ok $s.f4.cancel $s.f4.help -side left -padx 1m
  pack $s.f4.ok $s.f4.cancel -side left -padx 1m

  tkwait window $s.f4.ok

  if {$flag == "ok"} then {

    set a [$s.f3.ePeriod get]
    if {![catch "incr a"]} then {
      # it's an int
      incr a -1
      set PERIOD $a
    }

    set a [$s.f6.eBuffer get]
    if {![catch "incr a"]} then {
      # it's an int
      incr a -1
      set BUFFER $a
    }

    set a [$s.f7.ePort get]
    if {![catch "incr a"]} then {
      # it's an int
      incr a -1
      set HTTPPORT $a
    } else {
      set HTTPPORT 0
    }

    set a [$s.f9.eRetry get]
    if {![catch "incr a"]} then {
      # it's an int
      incr a -1
      if {$a<1} {set a 1}
      if {$a>20} {set a 20}
      set READRETRY $a
    }

    set COMMPORT [$s.f1.ePort get]
    set DUNITS $tempDUNITS

    saveConfig
    openPort
    updateView
    setupHttpServer
  }
  destroy $s
}

#
# open the log file name browser dialog.
#
proc dataDirBrowse {w e} {
  set a [tk_getSaveFile -parent $w]
  if {$a != ""} {
    global LOGFILE
    set LOGFILE $a
    saveConfig
    $e configure -state normal
    $e delete 0 end
    $e insert 0 $a
    $e configure -state disabled
  }
}

#
# quit button has been hit.
#
proc quit {} {
  global StillAlive PollTrig
#  destroy .
  set StillAlive 0
  set PollTrig 1
  exit
}

#
# open the "Probe Options..." dialog.
#
proc openProbes {} {
  set w ".probes"
  catch "destroy $w"

  global PERIOD COMMPORT
  global flag

  toplevel $w
  wm title $w "Probe Options..."

  frame $w.f1
  frame $w.f2
  frame $w.f3
  pack $w.f1 -side top -fill x -expand 0 -padx 1m -pady 1m 
  pack $w.f2 -side top -fill x -expand 1 -padx 1m -pady 1m -fill both
  pack $w.f3 -side top -fill x -expand 0 -padx 1m -pady 1m 

  button $w.f1.b -text "AutoDiscover All Attached Units/Probes" \
    -command "$w.f1.b conf -state disabled ; autoDiscover $w.f2 ; $w.f1.b conf -state active"
  pack $w.f1.b -side left -fill x

  text $w.f2.t -width 26 -height 15
  frame $w.f2.f 
  pack $w.f2.t $w.f2.f -side left -expand 1 -fill both

  button $w.f3.ok -text "Ok" -command "destroy $w.f3.ok"
#  button $w.f3.help -text "Help" -command "showHelp probes"
#  pack $w.f3.ok $w.f3.help -side left -padx 1m -fill x
  pack $w.f3.ok -side left -padx 1m -fill x
  
  setupProbeList $w.f2

  tkwait window $w.f3.ok
  destroy $w
  saveConfig
  setupCanvas
  updateView
}

#
# poll for all therms and probes connected
#
proc autoDiscover {f} {
  global portFP
  global probeList unitList numUnits numProbes
  global activeProbe

  $f.t delete 0.0 end

  set probeList ""
  set unitList ""
  set numUnits 0
  set numProbes 0

  lights 1
  set unit 0
  set found 1
  while {$found} {
    set found 0
    read $portFP
    puts -nonewline $portFP [binary format c [expr $unit+16]]
    after 200 ; update ; update idletasks 
    after 200 ; update ; update idletasks 
    after 200 ; update ; update idletasks 
    after 200 ; update ; update idletasks 
    after 200 ; update ; update idletasks 

    set A ""
    while {[string length [set a [read $portFP]]]} {
      append A $a
      after 200
      update ; update idletasks 
    }

    set probeNum 0
    foreach a [split $A "\n"] {
      $f.t insert end "$a\n"
      if {"T" == [string index $a 0]} then {
        lappend probeList [lindex $a 0]
        incr probeNum
      } elseif {"V" == [string index $a 0]} then {
        lappend unitList [string trim $a]
        set found 1
      }
      update idletasks
    }
    incr unit
  }
  lights 0

  set numUnits [llength $unitList]
  set numProbes [llength $probeList]
  $f.t insert end "
-------------------------
Found probes ($numProbes): $probeList
Found units ($numUnits): $unitList
-------------------------
"
  catch "unset activeProbe"
  foreach i $probeList {
    set activeProbe($i) 1
  }

  setupProbeList $f
}

#
# make menu of currently available probes.
#
proc setupProbeList {f} {
  global activeProbe logProbe  probeList nameProbe colorProbe

  # clear any present children of the side frame
  foreach i [winfo children $f.f] {
    catch "destroy $i"
  }
  
  set row 0
#  label $f.f.log -text Log
  label $f.f.active -text Active
  label $f.f.id -text ID
  label $f.f.col -text Color
  label $f.f.name -text Name
  label $f.f.alarm -text Alarm
  label $f.f.alo -text Lo
  label $f.f.ahi -text Hi
#  grid $f.f.log $f.f.active $f.f.id $f.f.col $f.f.name -row $row
  grid $f.f.active $f.f.id $f.f.col $f.f.name $f.f.alarm $f.f.alo $f.f.ahi -row $row
  foreach i $probeList {
    if {[catch "set colorProbe($i)"]} {
      set colorProbe($i) blue
    }
    if {[catch "set nameProbe($i)"]} {
      set nameProbe($i) $i
    }
    incr row
#    checkbutton $f.f.log$row -variable logProbe($i)
    checkbutton $f.f.active$row -variable activeProbe($i)
    label $f.f.l$row -text $i
    button $f.f.c$row -text "  " -background $colorProbe($i) -command \
	"setProbeColor $i $f.f.c$row $f"
    entry $f.f.e$row -textvariable nameProbe($i)
    checkbutton $f.f.alarm$row -variable alarmProbe($i)
    entry $f.f.alo$row -width 4 -textvariable aloProbe($i)
    entry $f.f.ahi$row -width 4 -textvariable ahiProbe($i)
#    grid $f.f.log$row $f.f.active$row $f.f.l$row $f.f.c$row $f.f.e$row \
#	-row $row
    grid $f.f.active$row $f.f.l$row $f.f.c$row $f.f.e$row \
        $f.f.alarm$row $f.f.alo$row $f.f.ahi$row \
	-row $row
  }
}

#
# open probe color picker dialog.
#
proc setProbeColor {i b w} {
  global colorProbe
  set a [tk_chooseColor -parent $w -title {Pick Color} -initialcolor $colorProbe($i)]
  if {[string length $a]} {
    if {[string index $a 0]=="1"} {
      # work around bizarre bug, sometimes color is prepended w/ "1"
      set a [string range $a 1 end]
    }
    set colorProbe($i) $a
  }
  $b config -background $colorProbe($i)
}

#
# open help window given a string of help text.
#
proc showHelp {text} {
  set h ".help"
  catch "destroy $h"

  toplevel $h
  wm title $h "Help"

  frame $h.f1
  button $h.ok -text Ok -command "destroy $h"

  pack $h.f1 -side top -fill both -expand 1 
  pack $h.ok -side top -fill y

  text $h.f1.text -relief sunken -bd 2  \
    -yscrollcommand "$h.f1.scroll set" -setgrid 1 \
    -height 30 -width 60 -wrap word
  scrollbar $h.f1.scroll -command "$h.f1.text yview"
  pack $h.f1.scroll -side right -fill y
  pack $h.f1.text -expand yes -fill both
  global HELP_$text
  $h.f1.text insert 0.0 [set HELP_$text]
}

#
# read config info from the config file.
# if config file doesn't exist, write default info to it.
#
proc loadConfig {} {
  global CONFIGFILE
  global tcl_platform
  global PERIOD BUFFER RANGE
  global COMMPORT LOGFILE DUNITS REREADLOG HTTPPORT READRETRY
  global numUnits numProbes probeList unitList
  global activeProbe nameProbe colorProbe alarmProbe aloProbe ahiProbe

  #
  # if no config file exist, create one
  #
  if {![file exists $CONFIGFILE]} {
    saveConfig
  }

  # now eval the config file as a tcl script
  #
  source $CONFIGFILE

  #
  # make sure there are entries for each active probe in some
  # variables we're going to use later.
  #
  foreach i [array names activeProbe T*] {
    if {! [info exists nameProbe($i)]} {
      set nameProbe($i) $i
    }
    if {! [info exists colorProbe($i)]} {
      set colorProbe($i) blue
    }
    if {! [info exists alarmProbe($i)]} {
      set alarmProbe($i) 0
    }
    if {! [info exists aloProbe($i)]} {
      set aloProbe($i) {}
    }
    if {! [info exists ahiProbe($i)]} {
      set ahiProbe($i) {}
    }
  }
}

#
# write current configuration info to the config file.
#
proc saveConfig {} {
  global CONFIGFILE
  global PERIOD BUFFER RANGE
  global COMMPORT LOGFILE DUNITS REREADLOG HTTPPORT READRETRY
  global numUnits numProbes probeList unitList
  global activeProbe nameProbe colorProbe alarmProbe aloProbe ahiProbe

  set a [open $CONFIGFILE w]
  puts $a "
	set PERIOD \{$PERIOD\}
	set BUFFER \{$BUFFER\}
	set RANGE \{$RANGE\}
	set COMMPORT \{$COMMPORT\}
	set LOGFILE \{$LOGFILE\}
	set DUNITS \{$DUNITS\}
	set REREADLOG \{$REREADLOG\}
	set HTTPPORT \{$HTTPPORT\}
	set READRETRY \{$READRETRY\}
	set numUnits \{$numUnits\}
	set numProbes \{$numProbes\}
	set probeList \{$probeList\}
	set unitList \{$unitList\}

  	"

  foreach n [array names activeProbe] {
    puts $a "set activeProbe($n) \{$activeProbe($n)\}"
  }
  foreach n [array names nameProbe] {
    puts $a "set nameProbe($n) \{$nameProbe($n)\}"
  }
  foreach n [array names colorProbe] {
    puts $a "set colorProbe($n) \{$colorProbe($n)\}"
  }
  foreach n [array names alarmProbe] {
    puts $a "set alarmProbe($n) \{$alarmProbe($n)\}"
  }
  foreach n [array names aloProbe] {
    puts $a "set aloProbe($n) \{$aloProbe($n)\}"
  }
  foreach n [array names ahiProbe] {
    puts $a "set ahiProbe($n) \{$ahiProbe($n)\}"
  }

  close $a
}

#
# open or reopen serial port to therms.
#
proc openPort {} {
  global COMMPORT
  global portFP
  global tcl_platform

  catch "close $portFP"
  catch "unset portFP"

  if {[catch "set portFP [open $COMMPORT RDWR]"]} then {
    logAlarm "Can't open serial port $COMMPORT"
#    tk_messageBox -icon error -type ok \
#      -title "Couldn't Open: $COMMPORT" \
#      -message "Couldn't Open: $COMMPORT"
  } else {
    if {$tcl_platform(platform) == "unix"} {
      fconfigure $portFP -mode 1200,n,8,1 -buffering none -blocking false
    } else {
      fconfigure $portFP -mode 1200,n,8,1 -buffering none
    }
  }
}

#
# open or reopen the HTTP server socket
#
proc setupHttpServer {} {
  global HTTPPORT HttpServer
  if {[info exists HttpServer]} {
    catch "close $HttpServer"
    unset HttpServer
  }
  if {$HTTPPORT > 0} {
    set HttpServer [socket -server handleHttp $HTTPPORT]
  }
}

proc httpHeader {type} {
  global ver
  set date [clock format [clock seconds] -format "%a, %d %b %Y %H:%M:%S GMT" -gmt 1]
  return "HTTP/1.0 200 OK\r
Date: $date\r
Server: HLTWare/$ver\r
Content-type: $type\r\n\r\n"
}

#
# convert temp in C to currently selected units.
#
proc CtoAny {c} {
  global DUNITS
  if {$DUNITS == "F"} {
    return [format "%.1f" [CtoF $c] ]
  } else {
    return [format "%.1f" $c]
  }
}

#
# convert temp in currently selected units to C.
#
proc AnyToC {a} {
  global DUNITS
  if {$DUNITS == "F"} {
    return [format "%.1f" [FtoC $a] ]
  } else {
    return [format "%.1f" $a]
  }
}

#
# convert temp in C to F.
#
proc CtoF {c} {
  return [expr ($c*1.8) +32]
}

#
# convert temp in F to C.
#
proc FtoC {f} {
  return [expr ($f-32)*5.0/9.0]
}

#
# format clock time into log file format
#
proc formatDate n {
  return [clock format $n -format "%Y/%m/%d %H:%M:%S"]
}

#
# reply to HTTP request for temp graph or log file.
# this is a safe wrapper for unsafeHandleHttp, which may fail,
# e.g. if the socket is closed from the remote end.
#
proc handleHttp {soc address port} {
  catch "unsafeHandleHttp $soc $address $port"
  close $soc
}

#
# reply to HTTP request for temp graph or log file.
#
proc unsafeHandleHttp {soc address port} {
  global ver
  set req [lindex [gets $soc] 1]


  if {[string compare $req "/"] == 0} {
    puts -nonewline $soc [httpHeader "text/html"]

    puts $soc "<table border=1>"
    puts $soc "<tr><th>Probe</th><th>C</th><th>F</th></tr>"
    global activeProbe temperature nameProbe
    foreach i [array names activeProbe T*] {
      if {$activeProbe($i)} {
        if {[catch "set t $temperature($i)"]} {
          set t "??"
          set tf "??"
        } else {
          set tf [CtoF $t]
        }
        puts $soc "<tr><td>$nameProbe($i)</td><td>$t</td><td>$tf</td></tr>"
      }
    }
    puts $soc "</table>"

    global jumper 
    foreach i [array names jumper] {
      puts -nonewline $soc "<p>jumper on $i = $jumper($i)\n"
    }

    puts -nonewline $soc "
	<p><a href=/hltware.eps>Get Encapsulated Postscript Graph Dump</a>
	<p><a href=/hltlog.txt>Get Log File</a>
	<hr><i>
	<a href=http://www.spiderplant.com/hlt/software/hltware/>HLTWare</a> $ver / 
	<a href=http://www.spiderplant.com/>Spiderplant</a></i>"

  } elseif {[string compare $req "/hltware.eps"] == 0} {
    global Canvas
    set pscolormap(white) "0.3 0.3 0.3 setrgbcolor"
    puts -nonewline $soc [httpHeader "application/postscript"]
    set ps [$Canvas postscript -colormap pscolormap -colormode color]
    puts -nonewline $soc $ps
  } elseif {[string compare $req "/hltlog.txt"] == 0} {
    puts -nonewline $soc [httpHeader "text/plain"]
    global LOGFILE
    if {[string length $LOGFILE] != 0} {
      set log [open $LOGFILE]
      while {![eof $log]} {
         puts -nonewline $soc [read $log 10240]
      }
      close $log
    } else {
      puts $soc "No Log File to be had"
    }
  } else {
    puts -nonewline $soc [httpHeader "text/html"]
    puts -nonewline $soc "unknown request: $req"
    puts -nonewline $soc "<hr><i>HLTWare $ver / 
	<a href=http://www.spiderplant.com/>Spiderplant</a></i>"
  }
}

#
# log text to the "Alarms" box, popping it up if it's not already
# mapped, and raising it to the top of the window stack.
#
proc logAlarm {message} {
  if {[winfo exists .alarm] } {
    if {[wm state .alarm] == "normal"} {
      raise .alarm
    } else {
      wm deiconify .alarm
    }
  } else {
    toplevel .alarm -bg red
    label .alarm.label -text "Hot Little Therm Alarms" -bg red -fg white
    text .alarm.msg -bg gold -width 50 -height 10
    frame .alarm.f
    button .alarm.f.b1 -text Close -command {wm withdraw .alarm} \
      -bg red -fg white -activebackground red -activeforeground white
    button .alarm.f.b2 -text Clear -command {.alarm.msg delete 0.0 end} \
      -bg red -fg white -activebackground red -activeforeground white
    pack .alarm.f.b1 .alarm.f.b2 -in .alarm.f -side left
    pack .alarm.label .alarm.msg .alarm.f -in .alarm -padx 10 -pady 10
  }
  .alarm.msg insert end "$message"
  .alarm.msg insert end "\n"
  .alarm.msg see end
}

# these are the predefined time scale values
set TimeText(60)      {1 minute}
set TimeText(120)     {2 minutes}
set TimeText(300)     {5 minutes}
set TimeText(600)     {10 minutes}
set TimeText(900)     {15 minutes}
set TimeText(1200)    {20 minutes}
set TimeText(1800)    {30 minutes}
set TimeText(3600)    {1 hour}
set TimeText(7200)    {2 hours}
set TimeText(10800)   {3 hours}
set TimeText(14400)   {4 hours}
set TimeText(21600)   {6 hours}
set TimeText(43200)   {12 hours}
set TimeText(86400)   {1 day}
set TimeText(172800)  {2 days}
set TimeText(259200)  {3 days}
set TimeText(604800)  {1 week}
set TimeText(1209600) {2 weeks}
set TimeText(2419200) {1 month}

set Times [lsort -integer [array names TimeText]]

#
# format a time in seconds as one of the entries in TimeText()
# if it matches, else as "%d seconds".
#
proc getTimeText {sec} {
    global TimeText
    if {[info exists TimeText($sec)]} {
	return $TimeText($sec)
    }
    return [format "%d seconds" $sec]
}

set HELP_main "HLTWare $ver"
append HELP_main {

This is the second release of HLTWare. It has been developed for use on Unix and Windows95/NT platforms but should work with trivial modifications on other Tcl/Tk supported platforms.


OPERATION:

The first time you start HLTWare, you need to select the correct serial port using the "Setup Options..." box. 

Next, select the "AutoDiscover" function from the "Probe Options..." box. This looks for therms on the serial port and gets the list of probes attached to each one.  Hit 'OK' after your probes have been detected.

At this point you should be in business, each probe is shown by name and graphed. You may wish to return to the "Probe Options..." box to assign a name or graph color to each probe or turn off any you don't care about.


ALARMS:

An alarm popup warns of exceptional conditions.  You can set individual low/high temperature limits on each probe.  If any probe temperature exceeds the limits, a red alarm box will pop up with a message.  The alarm box will also be triggered if any active probe cannot be read.


LOGGING:

If you set a log file name (via "Setup Options...") a line will be added to it each time the probes are sampled. If the log file doesn't already exist, a header line will be written first using the names currently assigned to each active probe.

The first column of the log file is the time the sample was taken.  The format of the time value is "yyyy/mm/dd hh:mm:ss".


ON BOARD WEB SERVER:

If you point a web browser at http://localhost:8080/ you will get a look at the current probe values and get download the log file. From other machines you'll need to replace localhost with the correct host name.  You can change the server port number in the "Setup Options..." box.


OTHER COMMENTS:

The sample period can be changed via the "Setup Options..." box. This is the period between samples, getting each sample takes an additional second or two.

}
if {$tcl_platform(platform) == "unix"} {
append HELP_main {
A configuration file is written to ~/hlt1.cfg
}
} else {
append HELP_main {
A configuration file is written to \HLT1.CFG
}
}
append HELP_main {

This needs more testing than it can get right now.  Please inform me of any problems you encounter or changes which would make it more useful.

Clicking in the graph area forces an immediate sample.

The current scale (-55 to +125C) is silly.


BUGS AND TODOS:

 - Much more documentation is needed
 - Need separate choices for logging and graphing each probe
 - Only works for v9 therms right now
 - Need selectable location for config file
 - The web server can only show the view that's on the screen
 - Alarm settings are not converted between C and F if units change
 - Would like a horizontal scrollbar for the plot
 - The plot should scale to min and max displayed temperatures
   (or at least the range should change for C and F)


AUTHOR:

 Reed Wade / Spiderplant
 rwade@spiderplant.com
 http://www.spiderplant.com/


HACKER:

 Robert Manchek / Spiderplant
 manchek@spiderplant.com
}

set HELP_setup {
This is the setup help document.

you shouln't be seeing this
}

set HELP_probes {
This is the probes help document.

you shouldn't be seeing this
}

######################
#  Default Settings  #
#                    #
######################

set PERIOD 15
set BUFFER 1000
set RANGE 300
if {$tcl_platform(platform) == "unix"} {
    set COMMPORT "/dev/ttyS0"
    set CONFIGFILE "~/hlt1.cfg"
} else {
    set COMMPORT "com1:"
    set CONFIGFILE "\\hlt1.cfg"
}
set LOGFILE ""
set DUNITS "C"
set REREADLOG "N"
set numUnits 0
set numProbes 0
set HTTPPORT 0
set READRETRY 1
set probeList ""
set unitList ""
set startTime [expr [clock seconds] -1]

####################
#  Initialization  #
#                  #
####################

loadConfig
setupHttpServer
openPort
setupCanvas

set errorCount 0
setPlotRange $RANGE

if {$REREADLOG == "Y"} {
  readLog
}

set StillAlive 1

set now $startTime
while {$StillAlive} {
  pollUpdate
  set togo [expr ($PERIOD-([clock seconds]-$now))*1000]
  if {$togo < 1} {
    set togo 1
  } elseif {$togo > $PERIOD*1000} {
    set togo [expr $PERIOD*1000]
  }
  after $togo "set PollTrig 1"
  vwait PollTrig
  set now [clock seconds]
}