#--------------------------------------------------------------------------
# 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
#--------------------------------------------------------------------------

source  object.tcl
set recoverfil 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 
     }
     set slot(Active) 1
     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 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 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
   Publish scancounts Spy
   Publish textstatus Spy
   Publish cscan User
   Publish sscan User
   Publish sftime Spy
   Publish scaninfo 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 l1 [split $r1 "="]
    append result "," [lindex $l1 1]
    append result "," [sicstime]
    set r1 [lastscancommand]
    set l1 [split $r1 "="]
    append result "," [lindex $l1 1]
    return [format "scaninfo = %s" $result]
}

#===================== Syntactical sugar around scan ===================
# center scan. A convenience scan for the one and only Daniel Clemens 
# at TOPSI. Scans around a given ceter 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
         }
}