#/bin/sh
# the next line restarts using tclsh \
exec wish "$0" "$@"

proc Restart_Server { } {
  DMM_Close
  DMM_Open
  Server_Close
  Server_Open
  Poll
}

proc Server_Open { } {
  global stuff

  if [catch { socket -server Net_Accept $::setting(ipport) } stuff(ipfid) ] {
    unset stuff(ipfid)
    set ok [ tk_messageBox -icon warning -type okcancel \
      -title "DMM Module Network Error" -message \
      "Cannot open socket on $::setting(ipport).\nModule already running?\nSelect Ok to continue anyway or Cancel to exit." ]
    if { $ok != "ok" } {
      DMM_Close
      exit
    }
    return
  }

  proc Net_Accept {newSock addr port} {
    fconfigure $newSock -buffering line
    fileevent $newSock readable [list Serve_Request $newSock]
  }
}

proc Server_Close { } {
  global stuff

  if { [ info exists stuff(ipfid) ] } {
    close $stuff(ipfid)
    unset stuff(ipfid)
  }
}

proc Serve_Request { sock } {
  global stuff
  if {[eof $sock] || [catch {gets $sock line}]} {
    close $sock
  } else {
    if { [ string length $line ] == 0 } {
      return
    }
    if {[string compare $line "?"] == 0} {
      Debug "Serve_Request" "Received query."
      Debug "Serve_Request" "Replying with $stuff(dmmval)."
      puts $sock $stuff(dmmval)
    } elseif {[string compare $line "stop!"] == 0} {
      Stop_DMM
    } elseif {[string compare $line "quit!"] == 0} {
      Net_Exit
    } else {
      Debug "Serve_Request" "Received unknown command."
      Dump_Buffer $line
    }
  }
}

# 
# DMM_Read - Accept data from serial port
#

proc DMM_Read { } {
  global stuff
  
  if {[eof $stuff(fid)] || [catch {gets $stuff(fid) r}]} {
    close $stuff(fid)
    unset stuff(fid)
  } else {
    if { [ string length $r ] == 0 } {
      return
    }
  }

  Debug "DMM_Read" "Received message"
  Dump_Buffer $r

  switch -exact -- $::setting(dmmtype) {
    "Tenma 72-7750" {
      set stuff(response) "$stuff(response)$r"
      Parse_Response
      return
    }
    default {
      tk_messageBox -icon error -type ok \
        -title "DMM Type Error" -message "Unknown DMM Type."      
      return
    }
  }
}

proc Parse_Response { } {
  global stuff

  switch -exact -- $::setting(dmmtype) {
    "Tenma 72-7750" {

      # Each character is used as follows:
      # <Scale><Value><Value><Value><Value><Units><Sign><?><AC/DC>
      # <Scale>: 0 = units
      #          1 = kilo
      #          2 = 10 kilo
      #          3 = 100 kilo
      #          4 = Mega
      #          5 = 10 Mega
      # <Value>...<Value>: Digits of numeric value, 6000 = over range
      # <Units>: 2 = Hz
      #          3 = Ohm
      #          4 = degC
      #          5 = ?
      #          6 = pF
      # <Sign>:  < = negative
      # <?>:     ?
      # <AC/DC>: :,8 = DC
      #          6,4 = AC

      set i [ string length $stuff(response) ]

      # don't have the full string yet.  retain.
      if { $i < 9 } {
        return
      }

      # get the raw value
      set raw [ string range $stuff(response) 0 8 ]

      # set the remaining string for next time
      set stuff(response) [ string range $stuff(response) 9 end ]

      # print the raw value
      set raw [ string range $raw 0 end-2 ]
      Debug "Parse_Response" "$raw"

      # extract numeric value
      scan [ string range $raw 1 4 ] "%d" val

      # set overflow
      set stuff(dmmover) 0
      if { $val == 6000 } {
        set val 0
        set stuff(dmmover) 1
      }

      # set display value
      if { [ string index $raw 6 ] == "<" } {
        set stuff(dmmval) [ expr 0 - $val ]
      } else {
        set stuff(dmmval) $val
      }

      # redraw
      Update_Canvas $stuff(dmmval)

      # set display AC/DC
      switch -exact -- [ string index $raw 8 ] {
        "0" {
          set stuff(dmmacdc) "N/A"
        }
        ":" -
        "8" {
          set stuff(dmmacdc) "DC"
        }
        "6" -
        "4" {
          set stuff(dmmacdc) "AC"
        }
        default {
          set stuff(dmmacdc) "?"
        }
      }

      # set display scale
      switch -exact -- [ string index $raw 0 ] {
        "5" {
          set stuff(dmmscale) "Mega"
        }
        default {
          set stuff(dmmscale) "?"
        }
      }

      # set units
      switch -exact -- [ string index $raw 5 ] {
        "2" {
          set stuff(dmmunits) "Hz"
        }
        "3" {
          set stuff(dmmunits) "Ohm"
        }
        "4" {
          set stuff(dmmunits) "degC"
        }
        "6" {
          set stuff(dmmunits) "pF"
        }
        "9" {
          set stuff(dmmunits) "A"
        }
        "?" {
          set stuff(dmmunits) "mA"
        }
        ";" {
          set stuff(dmmunits) "mV"
        }
        default {
          set stuff(dmmunits) "?"
        }
      }
      return
    }

    default {
      return
    }
  }
}

proc DMM_Write { b } {
  global stuff

  if { [ info exists stuff(fid) ] } {
    puts -nonewline $stuff(fid) $b
    flush $stuff(fid)
  }
}

proc Fix_Serial_Port_Name { s } {
  global tcl_platform

  switch -exact -- $tcl_platform(os) {
    "Linux" {
      return $s
    }
    "Darwin" {
      return $s
    }
    default {
      set s [ string map -nocase { c "" o "" m "" "\\" "" "." "" ":" "" } $s ]
      if { $s > 0 && $s < 10 } {
        set s "COM${s}:"
      } else {
        set s "\\\\.\\COM$s"
      }
      return $s
    }
  }
}

proc DMM_Open { } {
  global stuff

  if { $::setting(dmmport) == "" } {
    return
  }

  if { $::setting(dmmport) == "TCP/IP" } {

    Debug "DMM_Open" "Opening TCP/IP."

    if [catch {socket $::setting(dmmipaddr) $::setting(dmmipport)} stuff(fid)] {

      tk_messageBox -icon warning -type ok \
        -title "DMM Module IP Port Error" -message \
        "Cannot open connection to port $::setting(dmmipport) on $::setting(dmmipaddr)."
      return

    } else {

      fconfigure $stuff(fid) -buffering line

    }

  } else {

    set dmmport [ Fix_Serial_Port_Name $::setting(dmmport) ]
    Debug "DMM_Open" "Opening $dmmport."

    if [ catch { set stuff(fid) [ open $dmmport r+ ] } ] {
      tk_messageBox -icon warning -type ok \
        -title "DMM Module Serial Port Error" -message \
        "Cannot open $::setting(dmmport).\nModule already running?"
      return
    }

    Debug "DMM_Open" "DMM port $::setting(dmmport) open as $stuff(fid)."

    if { $::setting(sermode) != "" } {

      if [ catch { fconfigure $stuff(fid) -blocking 0 -buffering none \
        -encoding binary -translation { binary binary } \
        -mode $::setting(sermode) } ] {

        tk_messageBox -icon warning -type ok \
          -title "DMM Module DMM Port Error" -message \
          "Cannot configure $::setting(dmmport)."
      }
    }

    if { $::setting(serttycontrol) != "" } {

      if [ catch { fconfigure $stuff(fid) -handshake none \
        -ttycontrol $::setting(serttycontrol) } ] {

        tk_messageBox -icon warning -type ok \
          -title "DMM Module DMM Port Warning" -message \
          "Cannot configure $::setting(dmmport)."
      }
    }
  }

  fileevent $stuff(fid) readable DMM_Read
}

proc DMM_Close { } {
  global stuff

  if { [ info exists stuff(fid) ] } {
    close $stuff(fid)
    unset stuff(fid)
  }
}

proc Build_Debug { f } {
  global windows stuff

  toplevel $f
  wm withdraw $f
  wm title $f "Debug Log"
  wm protocol $f WM_DELETE_WINDOW { set stuff(debug) 0 ; wm withdraw $windows(debug) }

  set windows(debugtext) [ text $f.st \
   -width 80 -height 24 -yscrollcommand "$f.ssb set" ]
  scrollbar $f.ssb -orient vert -command "$f.st yview"
  pack $f.ssb -side right -fill y
  pack $f.st -side left -fill both -expand true

  return $f
}

proc Popup_Debug { } {
  global windows stuff

  wm deiconify $windows(debug)
  raise $windows(debug)
  focus $windows(debug)

  set stuff(debug) 1

  Debug "Popup_Debug" "Debug log enabled"
}

proc Debug { s m } {
  global windows stuff

  if { $stuff(debug) == 0 } {
    return
  }

  set t [clock seconds]
  set date [clock format $t -format "%Y-%m-%d"]
  set utc [clock format $t -format "%H:%M:%S"]
  set d "$date $utc"

  $windows(debugtext) insert end "$d $s: $m\n"
  $windows(debugtext) see end
  update idletasks
}

proc Dump_Buffer { b } {
  global windows stuff

  set n [ string length $b ]
  set r "buffer:"

  for { set i 0 } { $i < $n } { incr i } {
    scan [ string index $b $i ] "%c" c
    set r [ format "%s %02.2x" $r $c ]
  }

  Debug "Dump_Buffer" "$r"
}

proc Save_Loc { } {
  global .

  set fid [ open "dmm_loc.ini" w 0666 ]

  set t [clock seconds]
  set date [clock format $t -format "%Y-%m-%d"]
  set utc [clock format $t -format "%H:%M:%S"]
  set d "$date $utc"

  puts $fid "# Saved $d"

  set s [ wm state . ]
  puts $fid "# . $s"
  puts $fid "wm state . $s"
  set g [ wm geometry . ]
  puts $fid "# . $g"
  scan $g "%*dx%*d+%d+%d" x y
  puts $fid "wm geometry . =+$x+$y"

  close $fid
}

proc Save_Settings { } {

  set fid [ open "dmm.ini" w 0666 ]

  for { set handle [ array startsearch ::setting ]
    set index [ array nextelement ::setting $handle ] } \
    { $index != "" } \
    { set index [ array nextelement ::setting $handle ] } {

    Debug "Save_Settings" "$index"
    if { [ llength $::setting($index) ] > 1 } {
      puts $fid "set ::setting($index) \{$::setting($index)\}"
    } else {
      puts $fid "set ::setting($index) \"$::setting($index)\""
    }

  }
  array donesearch ::setting $handle

  close $fid
}


proc My_Exit { } {

  Server_Close
  DMM_Close
  Save_Loc
  Save_Settings

  exit
}

proc Stop_DMM { } {
  global stuff

  switch -exact -- $::setting(dmmtype) {
    "Tenma 72-7750" {
      return
    }
    default {
      return
    }
  }
}

proc Query { } {
  global stuff

  switch -exact -- $::setting(dmmtype) {
    "Tenma 72-7750" {

      # set up the command
      # set b "\r"

      # debug
      # Debug "Query_Freq" "Sending Tenma 72-7750 query"
      # Dump_Buffer $b

      # send query
      # DMM_Write $b
      return
    }
    default {
      return
    }
  }
}

proc Poll { } {
  global stuff

  if [ info exists stuff(afterjob) ] {
    after cancel $stuff(afterjob)
    unset stuff(afterjob)
  }

  switch -exact -- $::setting(dmmtype) {
    "Tenma 72-7750" {
      Query
    }
    default {
      return
    }
  }
  if { $::setting(pollint) > 0 } {
    set stuff(afterjob) [ after [ expr $::setting(pollint) * 1000 ] Poll ]
  }
}

#
# 0 = 325, 60 = 25
#
proc t2x { t } {
  return [ expr 325 - 5 * $t ]
}

proc temp2y { temp } {
  return [ expr 110 - ( 2 * $temp ) ]
}

proc Create_Canvas { f } {
  global windows

  canvas $f -width 335 -height 170 -bg black
  for { set i 0 } { $i < 61 } { incr i } {
    set windows(bar$i) [ $f create rectangle \
      [ t2x $i ] 150 [ expr [ t2x $i ] + 5 ] 10 -fill white ]
  }
  for { set i -20 } { $i < 60 } { incr i 10 } {
    if { $i < 50 } {
      set color red
    }
    if { $i < 40 } {
      set color yellow
    }
    if { $i < 20 } {
      set color white
    }
    if { $i < 0 } {
      set color blue
    }
    $f create text 10 [ temp2y $i ] \
      -text $i -fill $color -anchor center -justify center
  }
  for { set i 0 } { $i < 65 } { incr i 5 } {
    $f create text [ expr [ t2x $i ] + 5 ] 160 -text $i \
      -fill white -anchor center -justify center
  }

  return $f
}

proc Update_Canvas { value } {
  global windows stuff

  if { $stuff(toggle) == 1 } {
    set stuff(toggle) 0
    return
  }

  set stuff(toggle) 1

  for { set i 60 } { $i > 0 } { incr i -1 } {
    set j [ expr $i - 1 ]
    set coords [ $windows(cv) coords $windows(bar$j) ]
    set y [ lindex $coords 1 ]
    $windows(cv) coords $windows(bar$i) [ t2x $i ] 150 [ expr [ t2x $i ] + 5 ] $y 
  }
  $windows(cv) coords $windows(bar0) [ t2x 0 ] 150 [ expr [ t2x 0 ] + 5 ] [ temp2y $value ]
}

proc Init { } {
  global stuff tcl_platform

  set stuff(debug) 0

  switch -exact -- $tcl_platform(os) {
    "Linux" {
      set ::setting(dmmport) "/dev/ttyS0"
    }
    "Darwin" {
      set ::setting(dmmport) "/dev/cu.USA19QW11P1.1"
    }
    default {
      set ::setting(dmmport) "COM1:"
    }
  }

  set ::setting(sermode) "9600,n,8,1"
  set ::setting(serttycontrol) "RTS 1 DTR 0"

  set ::setting(pollint) 0
  set ::setting(dmmtype) "Tenma 72-7750"

  set ::setting(ipport) 32125

  set stuff(dmmover) 0
  set stuff(dmmval) 0
  set stuff(dmmacdc) "?"
  set stuff(dmmscale) "?"
  set stuff(dmmunits) "?"
  set stuff(response) ""
  set stuff(toggle) 1
}

set stuff(dmmtypes) { "Tenma 72-7750" }

# identify serial ports

  switch -exact -- $tcl_platform(os) {
    "Linux" {
      set stuff(serports) [ list "/dev/ttyS0" "/dev/ttyS1" ]
    }
    "Darwin" {
      set stuff(serports) [ list "/dev/cu.USA19QW11P1.1" "/dev/cu.USA19QW11P2.1" ]
    }
    default {
      package require registry

      set serial_base "HKEY_LOCAL_MACHINE\\HARDWARE\\DEVICEMAP\\SERIALCOMM"
      set values [ registry values $serial_base ]

      set result {}

      foreach valueName $values {
         set t [ registry get $serial_base $valueName ]
         set t "${t}:"
         lappend result $t
      }

      set result [ lsort -dictionary $result ]

      set stuff(serports) $result
    }
  }


menubutton .mbdmmport -text "DMM Port" -menu .mbdmmport.m -relief \
  raised
set w [menu .mbdmmport.m -tearoff 0]
foreach b $stuff(serports) {
  $w add radio -label $b -variable ::setting(dmmport) -value $b
}
$w add radio -label "TCP/IP" -variable ::setting(dmmport) -value "TCP/IP" 
entry .edmmport -textvariable ::setting(dmmport)

label .ldmmipaddr -text "DMM IP Address"
entry .edmmipaddr -textvariable ::setting(dmmipaddr)

label .ldmmipport -text "DMM IP Port"
entry .edmmipport -textvariable ::setting(dmmipport)

label .lsermode -text "Serial Port Mode"
entry .esermode -textvariable ::setting(sermode)

label .lserctrl -text "Serial Port Line Control"
entry .eserctrl -textvariable ::setting(serttycontrol)

label .lipport -text "Server IP Port"
entry .eipport -textvariable ::setting(ipport)

button .br -text "Start/Restart Server" -command Restart_Server

label .lpollint -text "Polling Interval (sec)"
entry .epollint -textvariable ::setting(pollint)

menubutton .mbdmmtype -text "DMM Type" -menu .mbdmmtype.m -relief \
  raised
entry .edmmtype -textvariable ::setting(dmmtype)
set w [menu .mbdmmtype.m -tearoff 0]
foreach b $stuff(dmmtypes) {
  $w add radio -label $b -variable ::setting(dmmtype) -value $b
}

label .lro -text "DMM Over Range"
entry .ero -textvariable stuff(dmmover)
label .lrv -text "DMM Value"
entry .erv -textvariable stuff(dmmval)
set windows(cv) [ Create_Canvas .cv ]
label .lrc -text "DMM AC/DC"
entry .erc -textvariable stuff(dmmacdc)
label .lrs -text "DMM Scale"
entry .ers -textvariable stuff(dmmscale)
label .lru -text "DMM Units"
entry .eru -textvariable stuff(dmmunits)
button .bx -text "Exit" -command My_Exit

grid .mbdmmport   .edmmport    -padx 2 -pady 2 -sticky ew
grid .ldmmipaddr .edmmipaddr  -padx 2 -pady 2 -sticky ew
grid .ldmmipport .edmmipport  -padx 2 -pady 2 -sticky ew
grid .lsermode    .esermode    -padx 2 -pady 2 -sticky ew
grid .lserctrl    .eserctrl    -padx 2 -pady 2 -sticky ew
grid .lipport     .eipport     -padx 2 -pady 2 -sticky ew
grid .br          -            -padx 2 -pady 2 -sticky ew
grid .lpollint    .epollint    -padx 2 -pady 2 -sticky ew
grid .mbdmmtype   .edmmtype    -padx 2 -pady 2 -sticky ew
grid .lro         .ero         -padx 2 -pady 2 -sticky ew
grid .lrv         .erv         -padx 2 -pady 2 -sticky ew
grid $windows(cv) -            -padx 2 -pady 2 -sticky news
grid .lrc         .erc         -padx 2 -pady 2 -sticky ew
grid .lrs         .ers         -padx 2 -pady 2 -sticky ew
grid .lru         .eru         -padx 2 -pady 2 -sticky ew
grid .bx          -            -padx 2 -pady 2 -sticky ew

set windows(debug) [ Build_Debug .debug ]
wm title . "DMM Module"
# if { $tcl_platform(os) != "Linux" && $tcl_platform(os) != "Darwin" } {
#   wm iconbitmap . dmm.ico
# }
wm protocol . WM_DELETE_WINDOW My_Exit
wm resizable . 0 0

Init

if { [ file readable "dmm.ini" ] } {
  source "dmm.ini"
}

bind all <Alt-Key-u> Popup_Debug

if { [ file readable "dmm_loc.ini" ] } {
  source "dmm_loc.ini"
}

Restart_Server