#--------------------------------------------------------------------------
# general scan command wrappers for TOPSI and the like. 
# New version using the object.tcl system from sntl instead of obTcl which
# caused a lot of trouble with tcl8.0
#
# Requires the built in scan command xxxscan.
#
# Mark Koennecke, February 2000
#--------------------------------------------------------------------------

#---------- adapt to the local settings
set home /data/koenneck/src

source  $home/sics/object.tcl

set datapath $home/tmp
set recoverfil $home/tmp/recover.bin

#-------------------------- some utility functions -------------------------
proc MC { t n } {
     set string $t
     for { set i 1 } { $i < $n } { incr i } {
       set string [format "%s%s" $string $t]
     }
     return $string
}
#--------------------------------------------------------------------------
proc GetNum { text } {
	set list [split $text =]
        return [lindex $list 1]
}
#---------------------------------------------------------------------------


#************** Definition of scan class **********************************

object_class ScanCommand {
   member Mode Monitor
   member NP   1
   member counter  counter
   member NoVar 0
   member Preset 10000
   member File  default.dat
   member pinterest ""
   member Channel 0
   member Active 0
   member Recover 0
   member scanvars
   member scanstart
   member scanstep
   member pinterest

   method var {name start step} {
     # check for activity
        if {$slot(Active)} {
          ClientPut "ERROR: cannot change parameters while scanning" error
          return 
        }
     # check parameters
        set t [SICSType $name]
        if { [string compare $t DRIV] != 0 } {
          ClientPut [format "ERROR: %s is not drivable" $name] error
          return 0
        }
        set t [SICSType $start]
        if { [string compare $t NUM] != 0 } {
          ClientPut [format "ERROR: %s is no number!" $start] error
          return 0
        }
        set t [SICSType $step]
        if { [string compare $t NUM] != 0 } {
          ClientPut [format "ERROR: %s is no number!" $step] error
          return 0
        }
# install the variable
        set i $slot(NoVar)
        incr slot(NoVar)
        lappend slot(scanvars) $name
        lappend slot(scanstart) $start
        lappend slot(scanstep) $step
        $self SendInterest pinterest ScanVarChange
        ClientPut OK
   }
   
   method info {} {
     if { $slot(NoVar) < 1 } {
       return "0,1,NONE,0.,0.,default.dat"
     }
     append result $slot(NP) "," $slot(NoVar)
     for {set i 0} { $i < $slot(NoVar) } { incr i} {
        append result "," [lindex $slot(scanvars) $i]
     }
     append result "," [lindex $slot(scanstart) 0] "," \
         [lindex $slot(scanstep) 0]
     set r1 [xxxscan getfile]
     set l1 [split $r1 "="]
     append result "," [lindex $l1 1]
     return $result
   }

   method getvars {} {
      set list ""
      lappend list $slot(scanvars)
      return [format "scan.Vars = %s -END-"  $list]
   }
   
   method xaxis {} {
      if { $slot(NoVar) <= 0} {
#---- default Answer
        set t [format "%s.xaxis = %f %f" $self 0 1]
      } else {
        set t [format "%s.xaxis = %f %f" $self [lindex $slot(scanstart) 0] \
              [lindex $slot(scanstep) 0] ]
      }
      ClientPut $t
   }

   method cinterest {} {
      xxxscan interest
   }
 
   method uuinterest {} {
      xxxscan uuinterest
   }

   method pinterest {} {
      set nam [GetNum [config MyName]]
      lappend $slot(pinterest) $nam
   }

   method SendInterest { type text } {
#------ check list first
      set l1 $slot($type)
      set l2 ""
      foreach e $l1 {
        set b [string trim $e]
        set g [string trim $b "{}"]
        set ret [SICSType $g]
        if { [string first COM $ret] >= 0 } {
           lappend l2 $e
        } 
      }  
#-------- update scan data and write
      set slot($type) $l2
      foreach e $l2 {
         set b [string trim $e]
         $b put $text
      }  
   }
  
   method mode { {NewVal NULL} } {
        if { [string compare $NewVal NULL] == 0  } {
             set val [format "%s.Mode = %s" $self $slot(Mode)]
             ClientPut $val
             return $val
        } else {
# check for activity
          if {$slot(Active)} {
            ClientPut "ERROR: cannot change parameters while scanning" error
            return 
          }
          set tmp [string tolower $NewVal]
          set NewVal $tmp
          if { ([string compare $NewVal "timer"] == 0) || \
               ([string compare $NewVal monitor] ==0) } {
               set slot(Mode) $NewVal
               ClientPut OK
          } else {
            ClientPut [format "ERROR: %s not recognized as ScanMode" $NewVal]
          }
        }  
   }

   method np { { NewVal NULL } } {
     if { [string compare $NewVal NULL] == 0 } {
       set val [format "%s.NP = %d" $self $slot(NP)]
       ClientPut $val
       return $val
     } else {
# check for activity
       if {$slot(Active)} {
            ClientPut "ERROR: cannot change parameters while scanning" error
            return 
       }
       set t [SICSType $NewVal]
       if { [string compare $t NUM] != 0 } {
         ClientPut [format "ERROR: %s is no number" $NewVal] error
         return
       }
       set slot(NP) $NewVal
       ClientPut OK
     }
   }

   method preset { {NewVal NULL} } {
     if { [string compare $NewVal NULL] == 0 } {
       set val [format "%s.Preset = %f" $self $slot(Preset)]
       ClientPut $val
       return $val
     } else {
# check for activity
       if {$slot(Active)} {
            ClientPut "ERROR: cannot change parameters while scanning" error
            return 
       }
       set t [SICSType $NewVal]
       if { [string compare $t NUM] != 0} {
         ClientPut [format "ERROR: %s is no number" $NewVal] error
         return
       }
       set slot(Preset) $NewVal
       ClientPut OK
     }
   }

   method file {} {
       return [xxxscan file]
   }

   method setchannel {num} {
          set ret [catch {xxxscan setchannel $num} msg]
          if { $ret == 0} {
            set slot(Channel) $num
          } else {
            return $msg
          }
   }

   method list { } {
       ClientPut [format "%s.Preset  = %f" $self $slot(Preset)]
       ClientPut [format "%s.Mode    = %s" $self $slot(Mode)]
       ClientPut [format "%s.File    = %s" $self $slot(File)]
       ClientPut [format "%s.NP      = %d" $self $slot(NP)]
       ClientPut [format "%s.Channel = %d" $self $slot(Channel)]
       ClientPut "ScanVariables:"
       for { set i 0 } {$i < $slot(NoVar) } { incr i } {
             ClientPut [format " %s %f %f" [lindex $slot(scanvars) $i] \
                  [lindex $slot(scanstart) $i]  \
                  [lindex $slot(scanstep) $i] ]
       }
   }

   method clear {} {
# check for activity
      if {$slot(Active)} {
         ClientPut "ERROR: cannot clear running scan" error
         return 
       }

       set slot(NP) 0
       set slot(NoVar) 0
       set slot(scanvars) ""
       set slot(scanstart) ""
       set slot(scanstep) ""
       $self SendInterest pinterest ScanVarChange
       xxxscan clear
       ClientPut OK
   }

   method getcounts {} {
     return [xxxscan getcounts]
   }

   method run { } {
# start with error checking
     if { $slot(NP) < 1 } {
        ClientPut "ERROR: Insufficient Number of ScanPoints"
        return
     }
     if { $slot(NoVar) < 1 } {
          ClientPut "ERROR: No variables to scan given!"
          return
     }
#-------  check for activity
     if {$slot(Active)} {
            ClientPut "ERROR: Scan already in progress" error
            return 
     }
     xxxscan clear
     for {set i 0 } { $i < $slot(NoVar)} {incr i} {
       set ret [catch {xxxscan add [lindex $slot(scanvars) $i] \
            [lindex $slot(scanstart) $i] [lindex $slot(scanstep) $i]} msg]
            if {$ret != 0} {
               set slot(Active) 0
               error $msg
       }
     }
     set slot(Active) 1
     set ret [catch \
         {xxxscan run $slot(NP) $slot(Mode) $slot(Preset)} msg]
     set slot(Active) 0
     if {$ret != 0 } {
           error $msg
     } else {
           return "Scan Finished"
     }
   }

   method recover {} {
       set slot(Active) 1
       catch {xxxscan recover} msg
       set slot(Active) 0  
       return "Scan Finished"
   }
   
   method forceclear {} {
      set slot(Active) 0
   }
}
#---- end of ScanCommand definition

#********************** initialisation of module commands to SICS **********

set ret [catch {scan list} msg]
#if {$ret != 0} {
   object_new ScanCommand scan
   Publish scan Spy
   VarMake lastscancommand Text User
   Publish scancounts Spy
   Publish textstatus Spy
   Publish cscan User
   Publish sscan User
   Publish sftime Spy
   Publish scaninfo Spy
   Publish wwwsics  Spy
#}

#*************************************************************************

#===================== Helper commands for status display work ============
# a new user command which allows status clients to read the counts in a scan
# This is just to circumvent the user protection on scan
proc scancounts { } {
     set status [ catch {scan getcounts} result]
     if { $status == 0 } {
       return $result
     } else {
       return "scan.Counts= 0"
     }
}
#---------------------------------------------------------------------------
# This is just another utilility function which helps in implementing the
# status display client
proc textstatus { } {
   set text [status]
   return [format "Status = %s" $text]
}
#---------------------------------------------------------------------------
# Dumps time in a useful format
proc sftime {} {
    return [format "sicstime = %s" [sicstime]]
}
#-------------------------------------------------------------------------
# Utility function which gives scan parameters as an easily parsable
# comma separated list for java status client
proc scaninfo {} {
    set result [scan info]
    set r1  [sample]
    set inf [string first = $r1]
    if {$inf > 0} {
       incr inf
       set sa [string range $r1 $inf end]
    } else {
      set sa Unknown
    }
    regsub -all , $sa " " sam
    append result "," $sam
    append result "," [sicstime]
    set r1 [lastscancommand]
    set l1 [split $r1 "="]
    append result "," [lindex $l1 1]
    return [format "scaninfo = %s" $result]
}
#----------------------------------------------------------------------
# wwwsics is a procedure which formats the most important status 
# information for the WWW-status. 
proc wwwsics {} {
#----- get all the data we need
 set user  [GetNum [user]]
 set sample [GetNum [sample]]
 set tit    [GetNum [title]]
 set ret [catch {lambda} msg]
 if {$ret != 0 } {
    set lam Undetermined
 } else {
    set lam [GetNum $msg]
 }
 set lscan [GetNum [lastscancommand]]
 set svar  [GetNum [scan getvars]]
 set ind [string last -END- $svar]
 if { $ind > 2 } {
   set svar [string range $svar 0 $ind]
 } else {
   set svar " "
 }
 set res [scan info]
 set l [split $res ,]
 set fil [lindex $l 5] 
 set run [GetNum [sicsdatanumber]]
 set stat [GetNum [status]]
#------- html format the reply
 append result "<table BORDER=2>"
 append result <tr> <th>Run Number</th> <td> $run </td> </tr>
 append result <tr> <th>Title</th> <td> $tit </td> </tr>
 append result <tr> <th>User</th> <td> $user </td> </tr>
 append result <tr> <th>Sample </th> <td> $sample </td> </tr>
 append result <tr> <th>wavelength</th> <td> $lam</td> </tr>
 append result <tr> <th>Status</th> <td> $stat</td> </tr>
 append result <tr> <th>Scan Variables</th> <td> $svar</td> </tr>
 append result <tr> <th>File </th> <td> $fil</td> </tr>
 append result <tr> <th>Last Scan Command</th> <td> $lscan</td> </tr>
 append result </table>
 return $result
} 
#===================== Syntactical sugar around scan ===================
# center scan. A convenience scan for the one and only Daniel Clemens 
# at TOPSI. Scans around a given center point. Requires the scan command 
# for TOPSI to work.
#
# another convenience scan:
# sscan var1 start end var1 start end .... np preset 
# scans var1, var2 from start to end with np steps and a preset of preset  
#
# Mark Koennecke, August, 22, 1997
#-----------------------------------------------------------------------------
proc cscan { var center delta np preset } {
#------ start with some argument checking
        set t [SICSType $var]
        if { [string compare $t DRIV] != 0 } {
          ClientPut [format "ERROR: %s is NOT drivable!" $var]
          return
        } 
        set t [SICSType $center]
        if { [string compare $t NUM] != 0 } {
          ClientPut [format "ERROR: %s is no number!" $center]
          return
        }
        set t [SICSType $delta]
        if { [string compare $t NUM] != 0 } {
          ClientPut [format "ERROR: %s is no number!" $delta]
          return
        }
        set t [SICSType $np]
        if { [string compare $t NUM] != 0 } {
          ClientPut [format "ERROR: %s is no number!" $np]
          return
        }
        set t [SICSType $preset]
        if { [string compare $t NUM] != 0 } {
          ClientPut [format "ERROR: %s is no number!" $preset]
          return
        }
#-------- store command in lastscancommand
        set txt [format "cscan %s %s %s %s %s" $var $center \
                 $delta $np $preset]
        catch {lastscancommand $txt}
#-------- set standard parameters
        scan clear
        scan preset $preset
        scan np [expr $np*2 + 1]
#--------- calculate start
        set start [expr $center - $np * $delta]
        set ret [catch {scan var $var $start $delta} msg]
        if { $ret != 0} {
          ClientPut $msg
          return
        }
#---------- start scan
        set ret [catch {scan run} msg]
        if {$ret != 0} {
           error $msg
        }
}
#---------------------------------------------------------------------------
proc sscan args { 
         scan clear
#------- check arguments: the last two must be preset and np!
         set l [llength $args]
         if { $l < 5} {
            ClientPut "ERROR: Insufficient number of arguments to sscan"
            return
         }
         set preset [lindex $args [expr $l - 1]]
         set np     [lindex $args [expr $l - 2]]
         set t [SICSType $preset]
         ClientPut $t
         ClientPut [string first $t "NUM"]
         if { [string compare $t NUM] != 0 } {
            ClientPut [format "ERROR: expected number for preset, got %s" \
                      $preset]
            return
         }
         set t [SICSType $np]
         if { [string compare $t NUM] != 0 } {
            ClientPut [format "ERROR: expected number for np, got %s" \
                      $np]
            return
         }
         scan preset $preset
         scan np $np
#--------- do variables
         set nvar [expr ($l - 2) / 3]
         for { set i 0 } { $i < $nvar} { incr i } {
            set var [lindex $args [expr $i * 3]]
            set t [SICSType $var]
            if {[string compare $t DRIV] != 0} {
              ClientPut [format "ERROR: %s is not drivable" $var]
              return
            }
            set start [lindex $args [expr ($i * 3) + 1]]
            set t [SICSType $start]
            if { [string compare $t NUM] != 0 } {
               ClientPut [format "ERROR: expected number for start, got %s" \
                        $start]
                return
            }
            set end [lindex $args [expr ($i * 3) + 2]]
            set t [SICSType $end]
            if { [string compare $t NUM] != 0 } {
               ClientPut [format "ERROR: expected number for end, got %s" \
                        $end]
                return
            }
#--------- do scan parameters
           set step [expr double($end - $start)/double($np)]
           set ret [catch {scan var $var $start $step} msg]
           if { $ret != 0} {
               ClientPut $msg
               return
           }
         }
#------------- set lastcommand text
         set txt [format "sscan %s" [join $args]]
         catch {lastscancommand $txt}
#------------- start scan
         set ret [catch {scan run} msg]
         if {$ret != 0} {
            error $msg
         }
}