# bookkeeping of moving items

proc TsState {} {
  global ts_status disconnect_time
  set tslist [list]
#  if {[info exists ts_status]} {
#    Newline
#    Style warning
#    Label $ts_status
#    NoNewline
#    Style warning
#    CheckBox redo check_connections
#  }
    
  if {[info exists disconnect_time(0)] && [DoubleTime] > $disconnect_time(0) + 4} {
    connection_details 1
  }
  foreach ts [silent "" ts_busy items] {
    set ins [result ts_busy $ts]
    set ilist($ins) 1
    set hlist([lindex [split $ts ":"] 0]) 1
    lappend tslist $ts $ins
    if {[connection_details]} {
      Newline
      Style hotwarning
      set INS [string toupper $ins]
      if {[info exists disconnect_time($ts)]} {
        if {[DoubleTime] < $disconnect_time($ts) + 4} {
          Label "trying to disconnect $ts from $INS"
        } else {
          CheckBox "unbook (only if you are sure $INS is not using $ts)" "forced_disconnect $ts"
        }
      } else {
        Tip "$ts is still connected to $INS" 
        CheckBox "disconnect $ts from $INS" "remote_disconnect $ts $ins/0"
      }
    }
  }
  if {[llength $tslist] == 0} {
    if {[array exists disconnect_time]} {
      array unset disconnect_time
      connection_details 0
    }
    return
  }
  set insts [array names ilist]
  if {[connection_details]} {
    Newline
    Style hotwarning
    CheckBox "show details" "connection_details"
  } elseif {[llength $insts] eq 1} {
    set rdev [string toupper [result device_on $insts]]
    set INS [string toupper $insts]
    Newline
    Style hotwarning
    if {[info exists disconnect_time(0)]} {
      Label "trying to disconnect $rdev from $INS"
    } else {
      Tip "$rdev is still connected to $INS"
      CheckBox "disconnect $rdev from $INS" "remote_device_none $insts/0"
    }
    NoNewline
    Style hotwarning
    CheckBox "show details" "connection_details"
  } else {
    if {[llength $tslist] > 2} {
      set ts [join [array names hlist] ,]
      if {[llength [array names hlist]] > 1} {
        append ts " are"
      } else {
        append ts " is"
      }
    } else {
      set ts "[lindex $tslist 0] is"
    }
    Newline
    Style hotwarning
    Tip "$ts already connected to [string toupper [join $insts ,]]"
    CheckBox "disconnect $ts from [string toupper [join $insts ,]]" "remote_disconnect $tslist/0"
    if {[llength $tslist] > 2} {
      NoNewline
      Style hotwarning
      CheckBox "show details" "connection_details"
    }
  }
}

set connection_details 0

proc connection_details {{on query}} {
  global connection_details
  if {$on ne "query"} {
    set connection_details $on
  }
  return $connection_details
}

proc disconnect_from {caller args} {
  foreach arg $args {
    set todo($arg) 1
  }
  set answer ""
  set confirm [list]
  foreach obj [obj_list items] {
    set type [driverKind $obj hostport]
    if {[info exists todo($hostport)]} {
      $obj disconnect
      append answer "disconnect $obj from $hostport\n"
      unset todo($hostport)
      lappend confirm $hostport
    }
  }
  foreach hp [array names todo] {
    append answer "no object found connected to $hp\n"
    lappend confirm $hp
  }
  if {[llength $confirm] != 0} {
    if {$caller ne "0"} {
      seaman / book_confirm $caller $confirm
    }
  }
  if {$answer eq ""} {
    append answer "nothing to disconnect"
  }
  clientput $answer
  return
}

proc save_samenv {{dev ""}} {
  if {[sicsdescriptor seaman] eq "notfound"} {
    return
  }
  if {$dev eq ""} {
    set dev [samenv name]
  }
  seaman / samenv_list makeitem [result instrument] $dev
  seaman / rack_list makeitem [rack] [result instrument]
}

publishLazy save_samenv

proc web_port {port} {
  device makeitem webport $port
  save_samenv
}

proc is_mobile_port {hostport} {
  # returns 0 when hostport is local to the instrument or a special value
  lassign [split $hostport :] host port
  if {$port eq "" || $host eq "samenv" || $host eq "localhost" || [string match "sample-ts*" $host]} {
    return 0
  }
  return 1
}

proc request_items {device} {
  global serverport ts_status
  
  if {[sicsdescriptor seaman] eq "notfound"} {
    return
  }
  foreach d [ts_busy items] {
    ts_busy deleteitem $d
  }
  set items {}
  foreach obj [obj_list items] {
    set hostport 0
    driverKind $obj hostport
    if {[is_mobile_port $hostport]} {
      lappend items $hostport
    }
  }
  seaman / book_request [result instrument] [info hostname]:$serverport $device $items
  set ts_status "Checking serial connections ..."
}

proc check_connections {{value -1}} {
  global ts_status
  if {$value == 1} {
    request_items [result device name]
  } elseif {[info exists ts_status]} {
    clientput $ts_status
  } else {
    clientput ok
  }
}

proc reconnect_object {obj {value 0}} {
  global serverport ts_status

  switch [driverKind $obj hostport] {
    stdsct {
      set obj $hostport
      driverKind $obj hostport
    }
    sctcontroller - ease {
    }
    default {
      error "unknown object for reconnect"
    }
  }
  if {[is_mobile_port $hostport]} {
    seaman / book_request [result instrument] [info hostname]:$serverport PARTIAL $hostport
    set ts_status "Checking serial connection ..."
  }
}

proc reconnect_or_set_busy args {
  global ts_status
  catch {unset ts_status}
  foreach a $args {
    if {[llength $a] > 1} {
      set item [lindex $a 0]
      set instr [lindex $a 1]
      if {[llength $a] > 2} {
        device_on makeitem $instr [lindex $a 2]
      }
      if {$instr eq "[result instrument]"} {
        if {[ts_busy exists $item]} {
          ts_busy deleteitem $item
        }
        set todo($item) 1
      } else {
        ts_busy makeitem $item $instr
      }
    } else {
      set item $a
      if {[ts_busy exists $item]} {
        ts_busy deleteitem $item
      }
    }
  }
  set answer ""
  foreach obj [obj_list items] {
    set type [driverKind $obj item]
    if {[info exists todo($item)]} {
      append answer "reconnect $obj to $item\n"
      $obj reconnect
    }
  }
  clientput $answer
  return
}

proc remote_disconnect {args} {
  global disconnect_time 
  if {[string length [lindex $args end]] == 1} {
    set args [lrange $args 0 end-1]
  }
  foreach {item instr} $args {
    set disconnect_time($item) [DoubleTime]
  }
  seaman / book_this [result instrument] $args
}

proc forced_disconnect {item {value 0}} {
  global disconnect_time 
  if {$value} {
    catch {unset disconnect_time($item)}
    seaman / book_confirm [result instrument] $item
  } else {
    return 0
  }
}

proc remote_device_none {instrument {value 0}} {
  global disconnect_time
  seaman / device_none_on $instrument
  set disconnect_time(0) [DoubleTime]
}

#proc make_rem_controller {name hostport} {
#
#  set typ [sicsdescriptor sics]
#  if {$typ eq "notfound"} {
#    remob server sics localhost.localdomain 8647
#  }
#  if {[sicsdescriptor sics] eq "RemServer"} {
#    remob obj $name sics 
#    sics $name reconnect $hostport
#  }
#  obj_list makeitem $name "$name rem_controller"
#}

proc seaman_set_rack args {
  global rack_list
  global rack_list_old
  set rack [lindex $args 0]
  if {$rack eq "start"} {
    array unset rack_list_old
    array set rack_list_old [array get rack_list]
  } elseif {$rack eq "end"} {
    foreach old [array names rack_list_old] {
      unset rack_list($old)
    }
  } else {
    set rack_list($rack) [lrange $args 1 end]
    unset -nocomplain rack_list_old($rack)
  }
}

publish disconnect_from User
publish request_items User
publish reconnect_or_set_busy User
publish remote_disconnect User
publish forced_disconnect Spy
publish reconnect_object User
publish connection_details Spy
publish remote_device_none User
publish check_connections User
publish seaman_set_rack User