#!/bin/sh
#\
exec $CODA_BIN/dpwish -f "$0" ${1+"$@"}
#
#
# 19.08.1998 (saw) Initial hack
# 22.08.1998 (saw) Bring up all dangerous buttons disabled by default.
# 24.09.1998 (mz)  Added TS checkout
# 20.11.1998 (dja) generalized code for use with any experiment
#                  added some visual features.
#

global gbcolor TITLE ERNAME EBNAME TSNAME alllist roclist otherlist version enabled timestamp
set BGCOLOR "cadetblue"

set TITLE "CODA component status monitor"
set version "ver 1.1"

set ERNAME ""
set EBNAME ""
set TSNAME ""
set KCODAS ""
set roclist ""
set otherlist ""
set alllist ""

set config ""
set configlist ""
set db ""

set enabled 1
set res ""

# Check if environment is set up correctly
if {[catch "set tmp \$env(CODA)" res]} {
   puts $res
   puts "CODA Environment not set up: setenv CODA"
   exit
}
if {[catch "set tmp \$env(SESSION)" res]} {
   puts $res
   puts "CODA Session not defined: setenv SESSION"
   exit
}
if {[catch "set tmp \$env(KILL_CODA_SCRIPT)" res]} {
   puts $res
   puts "CODA Kill Script not defined: setenv KILL_CODA_SCRIPT"
   exit
}
set env(ITCL_LIBRARY) "$env(CODA)/common/lib/itcl2.0"
set env(TCL_LIBRARY) "$env(CODA)/common/lib/tcl7.4"
set env(DP_LIBRARY) "$env(CODA)/common/lib/dp"


proc getconfig {} {
  global argv env BGCOLOR ERNAME EBNAME TSNAME roclist otherlist alllist config configlist db

# connect to msql Database
  if {[catch "set msql_host \$env(MSQL_TCP_HOST)" res]} {
     # MSQL_TCP_HOST not defined - Assume local host
     set msql_host ""
  }
  msql connect db $msql_host
  set dblist [db get databases]
  if {[lsearch $dblist $env(EXPID)] == -1} {
     puts $dblist
     puts "$env(EXPID) not found in database list"
     exit
  }
  db set database $env(EXPID)
  set config ""
  
# setup GUI to display list of configurations (Run Types)
  . configure -bg $BGCOLOR
  wm title . "Select Config" 

  frame .f1 -relief groove -bg $BGCOLOR
  label .f1.l1 -text "EXPID = $env(EXPID)" -bg $BGCOLOR
  pack .f1 -pady 1m -fill x
  pack .f1.l1

  frame .f2 -relief flat -bg $BGCOLOR 
  pack .f2 -side top
  listbox .f2.configs -relief raised -borderwidth 2 -yscrollcommand ".f2.cscroll set"
  pack .f2.configs -side left
  scrollbar .f2.cscroll -command ".f2.configs yview"
  pack .f2.cscroll -side right -fill y
  db query "select name from runTypes"
  while { [set x [db get next]] != ""} {
     lappend configlist $x
     .f2.configs insert end $x
  }

  frame .f3 -relief flat -bg $BGCOLOR 
  button .f3.b1 -text "OK" -command "set config \[selection get\]"
  button .f3.b2 -text "Exit" -command "exit"
  pack .f3 -side bottom -pady 1m -fill x
  pack .f3.b1 -side left
  pack .f3.b2 -side right

# wait until config is selected or exit
  tkwait variable config  

# Read selected Configuration and Setup Lists/Tables of Components
  set complist ""
  set complistType ""
  db query "select name from $config"
  while { [set x [db get next]] != ""} {
     lappend complist $x
  }
  foreach x $complist {
     db query "select type from process where name='$x'"
     lappend complistType [db get next]
  }
  set roclist ""
  for {set i 0} {$i < [llength $complist]} {incr i 1} {
     switch [lindex $complistType $i] {
          ROC {lappend roclist [lindex $complist $i]}
          TS  {set TSNAME [lindex $complist $i]}
          EB  {set EBNAME [lindex $complist $i]}
          ER  {set ERNAME [lindex $complist $i]}
          default {puts "Component [lindex $complist $i] not included Type=[lindex $complistType $i]"}
     }
  }
  if {$TSNAME != ""} {lappend roclist $TSNAME}
  if {$EBNAME != ""} {set otherlist [list $EBNAME]}
  if {$ERNAME != ""} {set otherlist [list $ERNAME $EBNAME]}
  if {$otherlist != ""} {set alllist [concat $otherlist $roclist]} else {set alllist [list $roclist]}

  destroy .f1
  destroy .f2
  destroy .f3
}

proc statustimeout {arg} {
    .f1.line_$arg.stat config -bg yellow
    return "timeout?"
}

proc getstatus {} {
    global STATUS compls timestamp
    foreach comp [array names compls] {
	set errcode [catch {set STATUS($comp) [DP_ask -timeout 1500 -timeoutReturn "statustimeout $comp" $comp status]} errstring]
	if {$errcode !=0 } {
	    .f1.line_$comp.stat config -bg red
	    set STATUS($comp) "down?"
	} else {
	    .f1.line_$comp.stat config -bg green
        }
    }
    set timestamp [exec date]
}

proc reboot {comp} {
    global compls
    if {$compls($comp) == "Reboot"} {
	set status [DP_tell $comp exec reboot]
    } else {
	set status [DP_tell $comp zap]
    }
}

proc resetcomp {comp} {
      set status [DP_tell $comp exit]
}
    

proc tscheck {} {
  global BGCOLOR TSNAME roclist
  toplevel .t
  .t configure -bg $BGCOLOR
  wm title .t "ROC and Trigger Supervisor Checkout" 
  frame .t.f1 -relief groove -bg $BGCOLOR
  pack .t.f1 -pady 1m -fill x
  label .t.f1.l1 -text "Trigger Supervisor:" -bg $BGCOLOR
  button .t.f1.b1 -text "State" -command "ts_comm $TSNAME tsState 1"
  button .t.f1.b2 -text "Status" -command "ts_comm $TSNAME tsStatus 2"
  pack .t.f1.l1 .t.f1.b1 .t.f1.b2  -side left -padx 2m -pady 1m

  if {$TSNAME == ""} {
    .t.f1.b1 configure -state disabled
    .t.f1.b2 configure -state disabled
  }

  frame .t.f2 -relief groove -bg $BGCOLOR
  pack .t.f2 -pady 1m -fill x
  label .t.f2.l1 -text "Buffer Status:" -bg $BGCOLOR
  pack .t.f2.l1 -side left -padx 2m -pady 0m
  set i 1
  foreach roc $roclist {
      button .t.f2.b$i -text $roc -command "roc_comm $roc part_stats_all"
      pack .t.f2.b$i  -side left -padx 0m -pady 0m
      incr i 1
  }

  frame .t.f3 -relief groove -bg $BGCOLOR
  pack .t.f3 -pady 1m -fill x
  label .t.f3.l1 -text "ROC Status:  " -bg $BGCOLOR
  pack .t.f3.l1 -side left -padx 2m -pady 1m
  set i 1
  foreach roc $roclist {
      button .t.f3.b$i -text $roc -command "roc_comm $roc roc_dump"
      pack .t.f3.b$i  -side left -padx 0m -pady 1m
      incr i 1
  }


  frame .t.f4 -relief flat -bg $BGCOLOR
  pack .t.f4 
  text .t.f4.text -relief sunken -bd 2 -font fixed -yscrollcommand ".t.f4.scroll set"
  scrollbar .t.f4.scroll -command ".t.f4.text yview"
  pack .t.f4.text .t.f4.scroll -side left -fill y

  frame .t.f5 -relief flat -bg $BGCOLOR 
  button .t.f5.b1 -text "Close" -command "destroy .t"
  pack .t.f5 -side bottom
  pack .t.f5.b1
}  

proc ts_comm {ts comm n} {

#   DP_tell $ts exec ts_init_1 0,1
   set errcode [catch {set string2 [DP_ask -timeout 1500 -timeoutReturn \
                 statustimeout TS1 exec $comm $n]}]
   if {$errcode != 0} {
        set string "$ts seems to be down"
   } 
   .t.f4.text delete 1.0 end
   .t.f4.text insert end \n
   .t.f4.text insert end $string2
    
}

proc roc_comm {roc comm} {
    
   set errcode [catch {set string [DP_ask -timeout 1500 -timeoutReturn \
                 statustimeout $roc $comm]}]
   if {$errcode != 0} {
        set string "$roc seems to be down"
   } 
   .t.f4.text delete 1.0 end
   .t.f4.text insert end \n
   .t.f4.text insert end $string
    
}

proc titlebar {} {
    global TITLE version BGCOLOR

    frame .title -bg $BGCOLOR -bd 2 -relief groove
    pack .title -side top -padx 1m -pady 1m -expand 1 -fill x

    label .title.name -text $TITLE -bg $BGCOLOR
    pack .title.name -in .title -padx 1m -pady 1m -side left
  
    label .title.version -text $version -bg $BGCOLOR
    pack .title.version -in .title -padx 1m -pady 1m -side right 

}

proc topmenu {} {
    global BGCOLOR
    frame .menu -bg $BGCOLOR -relief raised -bd 2
    pack .menu -side top -expand 1 -fill x

    menubutton .menu.config -bg $BGCOLOR -text "Config" -underline 0 \
	    -activebackground white -activeforeground black \
	    -menu .menu.config.menu
    menu .menu.config.menu \
	    -bg $BGCOLOR \
	    -activebackground white \
	    -activeforeground black 
    .menu.config.menu add command \
	    -label "Enable buttons" -underline 0 -command "setstate normal"
    .menu.config.menu add command \
	    -label "Exit" -underline 0 -command "exit "
    pack .menu.config \
	    -side left \
	    -in .menu
}

proc statusboot {} {
    global BGCOLOR compls alllist timestamp
    frame .f1 -bg $BGCOLOR -relief groove -bd 2
    pack .f1 -side left -fill both -anchor n -expand 1 -padx 1m -pady 1m

    foreach component $alllist {
	frame .f1.line_$component -bg $BGCOLOR
	pack .f1.line_$component -side top
	label .f1.line_$component.name -text ${component}: -width 6 \
               -anchor e -padx 1m -pady 1m -background $BGCOLOR
	label .f1.line_$component.stat -textvariable STATUS($component) \
              -relief groove -bd 2 -background red -pady 1m -padx 1m -width 11
	button .f1.line_$component.reboot -text $compls($component) \
               -command "reboot $component" -width 6 -bg yellow
	button .f1.line_$component.reset -text "Reset" -command "resetcomp $component" -width 6 -bg yellow
	pack .f1.line_$component.name .f1.line_$component.stat \
             .f1.line_$component.reset .f1.line_$component.reboot \
             -side left -pady 0m
    }


    label .f1.time -textvariable timestamp -pady 1m -bg $BGCOLOR
    pack .f1.time -side top

    set timestamp "Time of last status check"
    
    button .f1.getstatus -text "Get Status" -command getstatus -pady 2m
    pack .f1.getstatus -in .f1 -side top -pady 1m

}

proc startbuttons {} {
    global BGCOLOR cbutton

    frame .f2 -bg $BGCOLOR -relief groove -bd 2
    pack .f2 -fill both -anchor e -expand 1 -padx 1m -pady 1m

    label .f2.title -bg $BGCOLOR -text "Startup"
    pack .f2.title -in .f2 -padx 1m -pady 1m 

    set i 0
    foreach bname [lsort [array names cbutton]] {
	if {$bname != "KILL ALL"} {
	    button .f2.button$i -text $bname -command $cbutton($bname) \
		    -bg yellow -width 20 -state disabled
	    pack .f2.button$i -in .f2
	    incr i 1
	}
    }

    set bname "KILL ALL"
    button .f2.button$i -text $bname -command $cbutton($bname) \
	    -bg red -state disabled
    pack .f2.button$i -in .f2 -side bottom -pady 3m
    
}

proc tsdebug {} {
    global BGCOLOR
    frame .f3 -bg $BGCOLOR -relief groove -bd 2
#    pack .f3 -fill both -anchor e -expand 1 -padx 1m -pady 1m
    pack .f3 -fill both -padx 1m -pady 1m

    label .f3.title -bg $BGCOLOR -text "Debugging TS and ROCs"
#    pack .f3.title -in .f2 -padx 1m -pady 1m 
    pack .f3.title -pady 2m 

    button .f3.b -text "CHECK" -command tscheck
    pack .f3.b -pady 1m
}

proc setstate {state} {
    global cbutton compls ERNAME EBNAME
    set i 0
    foreach bname [lsort [array names cbutton]] {
	.f2.button$i configure -state $state
	if {$bname == "Event Recorder"} {
	   if {$ERNAME == ""} {.f2.button$i configure -state disabled}
        } 
        if {$bname == "Event Builder"} {
	   if {$EBNAME == ""} {.f2.button$i configure -state disabled}
        }
        incr i 1
    }
    foreach component [array names compls] {
	.f1.line_$component.reboot configure -state $state
	.f1.line_$component.reset configure -state $state
    }
    if { $state == "normal" } {
	.menu.config.menu entryconfigure 1 -label "Disable buttons" \
		-command "setstate disabled"
    } else {
	.menu.config.menu entryconfigure 1 -label "Enable buttons" \
		-command "setstate normal"
    }
}

# Start execution 
getconfig

# Define commands for cleaning up starting and stopping
set "cbutton(Event Recorder)" "exec xterm -ls -font fixed \
      -g 80x10-0+740 -sb -sl 500 -bg yellow\
      -e $env(CODA_BIN)/coda_er -i -s $env(SESSION) -n $ERNAME -t ER & "
set "cbutton(Event Builder)" "exec xterm -ls -font fixed \
      -g 80x10-0+570 -sb -sl 500 -bg yellow\
      -e $env(CODA_BIN)/coda_eb -i -s $env(SESSION) -n $EBNAME -t CDEB &"
set "cbutton(Run Control)" " exec xterm -ls -font fixed \
      -g 80x10-0+0  -T rcServer -iconic -sb -sl 500 \
      -e $env(CODA_BIN)/runcontrol -s $env(SESSION) &"
set "cbutton(ET System)" " exec xterm -ls -font fixed \
      -g 80x10-0+0  -T ET -iconic -sb -sl 500 \
      -e $env(CODA_BIN)/et_start &"
set "cbutton(Message Logger)" "exec cmlog &"
set "cbutton(KILL ALL)" "exec $env(KILL_CODA_SCRIPT) \>& /dev/null )"


wm title . "CODA MASTER"
. configure -bg $BGCOLOR


foreach roc $roclist {
    set compls($roc) "Reboot"
}

foreach comp $otherlist {
    set compls($comp) "Kill"
}

topmenu 

titlebar

statusboot

startbuttons

tsdebug

setstate disabled

