sics/sycamore.tcl

#source $sychome/stooop/mkpkgidx.tcl
#source stooop.tcl
#set tcl_pkgPath $sychome
# ClientPut $tcl_pkgPath "value"
# package require stooop 4        ;# load stooop package
# namespace forget stooop::*      ;# remove if previously loaded
# namespace import stooop::*       

# -----------------------------------------------------------------------------
# source $sychome/ns_site.tcl
# source $sychome/ns_sequencer.tcl
# source $sychome/ns_server.tcl

 set STACKTRACE 0
 proc stackTrace args {
   set level [ info level ]
     ClientPut "====================" "value"
     for {set i 1} {$i < $level} {incr i} {
       ClientPut [info level $i] "value"
       ClientPut " " "value"
     }
     ClientPut "====================" "value"
 }

# -----------------------------------------------------------------------------
# testing stubs when SICS modules not available 
# proc sinfox args 
# proc ClientPut {msg oCode}
# proc SICSType {objName}
# source stubs.tcl

# -----------------------------------------------------------------------------
# Sycamore Utilities: tcl procedures required by sycamore implementation

 proc sinWrite {msg oCode} {
 # simplest processing of format for now
    global STACKTRACE
    if {$STACKTRACE} {
    stackTrace
    }
     ClientPut $msg $oCode
 }
 
 proc varexist {nsp var} {
     return [expr [string compare $nsp$var [namespace which -variable $nsp$var]]==0]
 }
 
#proc sycFormat {connID transID devID msgFlag args} {
#  return "\[$connID:$transID:$devID:$msgFlag\] $args"
#}
#source $sychome/sycFormat.tcl
#publish sycFormat spy

 proc arga argStr {
     set args [ split $argStr ]
     set argc [llength $args]
     # syc::debug "arga.argc = %s" $argc
     set objName ""
     set key ""
     set name ""
     set val ""
 	set bObj [expr $argc > 0]
     set bKey [expr $argc > 1]
     set bName [expr $argc > 2]
     set bVal [expr $argc > 3]
 	if $bObj {
 	    set objName [string tolower [lindex $args 0]]
 	    #syc::debug "arga.objName = %s" $objName
 	} 
     if $bKey {
       	set key [string tolower [lindex $args 1]]
 	    #syc::debug "arga.key = %s" $key
     }
     if $bName {
        	set name [string tolower [lindex $args 2]]
     }
     if $bVal {
     	set val [string tolower [lindex $args 3]]
     }    
# ? cannot get 'array set' to work in the form:
# array set argv {
#   argc    $argc
#   objName $objName
#   ... etcetera
# }
    set argv(argc)    $argc
    set argv(bObj)    $bObj
    set argv(bKey)    $bKey
    set argv(bName)   $bName
    set argv(bVal)    $bVal
    set argv(objName) $objName
    set argv(key)     $key
    set argv(name)    $name
    set argv(val)     $val
    # would like to return associative array
    # for now, settle for list
    # syc::debug "arga.argv = { %s }" [array get argv]
    return [array get argv]
 }
     
 # alternative solution for passing arguments around
 #class argv {
 #    proc argv {this args} {
 #        set ($this,argc) [llength $args]
 #        set ($this,objName) ""
 #        set ($this,key) ""
 #        set ($this,name) ""
 #        set ($this,val) ""
 #    	set ($this,bObj) [expr $l > 0]
 #        set ($this,bKey) [expr $l > 0]
 #        set ($this,bName) [expr $l > 1]
 #        set ($this,bVal) [expr $l > 2]
 #    	if $($this,bObj) {
 #    	    set ($this,objName) [lindex $args 0]
 #    	} 
 #        if $($this,bKey) {
 #          	set ($this,key) [lindex $args 0]
 #        }
 #        if $($this,bName) {
 #           	set ($this,name) [lindex $args 1]
 #        }
 #        if $($this,bVal) {
 #        	set ($this,val) [lindex $args 2]
 #        }    
 #    }
 #    proc ~argv {this} {} 
 #}
 #        
 ## -----------------------------------------------------------------------------
 # working idea for making diagnostic class global
 class diagnostic {
     proc diagnostic {this} {
         set ($this,id) $this
         set ($this,debug) 0
     }
     proc ~diagnostic {this} {}
     
     proc diag {this flag} {
         set msg [format "diag=%s" $flag]
         switch $flag {
             "on" {
                 set ($this,debug) 1
             }
             "off" {
                 set ($this,debug) 0
             } 
             default {}
         }
         if {1 == ($this,debug)} {
             set msg "diag=on"
         } else {
             set msg "diag=off"
         }
         return [format "%s.diag = \{ %s \}" $this $msg]
     }
     
     proc debug {this dMsg dVal} {
         if {1 > ($this,debug)} {
             return
         }
         sinWrite [format "%s::debug: %s" $this [format $dMsg $dVal]] "value"
     }
 }
 
 ## -----------------------------------------------------------------------------
 # Class for module static variables and methods
 class syc {
     # class lifecycle methods
     proc syc {this} {}
     proc ~syc {this} {}
 
     # static data members
     set debug 0
 
     # static methods
     proc debug args {
         if {$syc::debug < 1} {
             return
         }
         set l [llength $args]
         set dMsg "Script code event"
         set dVal " "
         if {$l > 0} {
             set dMsg  [lindex $args 0]
             if {$l > 1} {
                 set dVal  [lindex $args 1]
             }
         }
         sinWrite [format "syc::debug: %s" [format $dMsg $dVal]] "value"
     }
     
     proc diag args {
         set flag [lindex $args 0]
         set msg [format "diag=%s" $flag]
         switch $flag {
             "on" {
                 set syc::debug 1
             }
             "off" {
                 set syc::debug 0
             } 
             default {
                 if {1 == $syc::debug} {
                     set msg "diag=on"
                 } else {
                     set msg "diag=off"
                 }
             }
         }
         return [format "syc.diag = \{ %s \}" $msg]
     }    
 }
 
 ## -----------------------------------------------------------------------------
 sinWrite "Loading sinfo" "value"
#source $sychome/sinfo.tcl
#publish sinfo spy
 # source $sychome/sequencer.tcl