#This function dumps an array and is used in debugging
#utility function to check what's been done!
proc DumpArray {Arr} {
    global $Arr
    set sid [array startsearch $Arr]
    while {[array anymore $Arr $sid]} {
	set val [array nextelement $Arr $sid]
	puts "[array get $Arr $val]"
    }
    array donesearch $Arr $sid
}


#
# pdbReadParam - This functions is responsible for reading in
# an a hierarchy from the directories specified.  This routine
# is called when parameters are fetched from arrays that do not
# yet exist.  The parameter files are tcl scripts which create the
# asked for array.
#
proc __pdbReadParam {Base} {
    global pdbPath
    global $Base

    #build the directory name to look for
    regsub -all & $Base / dirend
    set indx 0
    if { [string first [string index $Base 0] 0123456789] != -1 } {
	set indx [string index $Base 0]
	set dirend [string range $dirend 1 end]
    }

    set dir [lindex $pdbPath $indx]

    #read the location
    set dir $dir/$dirend
    if { [file isdirectory $dir] } { set list [source $dir/Info]
    } elseif {[file exists $dir]} { set list [source $dir]
    } else { set list "" }

    #the first location is treated special - its the default update dir!
    if { $indx == 0 && [llength $list] != 0} { 
	array set $Base "Modify {$list}" 
    }
}


#deep level procedure used only by pdbBuild
#
# pdbBuildNext - this routine takes an array space name and the name
# of the next level down the hierarchy.  It creates directory space
# to represent this next level of heirarchy in the local parameter
# directory.  Called only by pdbBuildNext.
#
proc __pdbBuildNext {WriteDir Arr Par} {
    global pdbHeaderFile

    #build the current path so far
    regsub -all & $Arr / file
    set file $WriteDir/$file
    set Final ${Arr}&$Par

    #check and see if this exists as a directory...
    if { ![file isdirectory $file/$Par] } {
	#if we have file, make a directory and move the file into Info
	if { [file exists $file] && ![file isdirectory $file] } {
	    exec mv $file $file.tmp
	    exec mkdir $file
	    exec mv $file.tmp $file/Info
	} 
	exec cp $pdbHeaderFile $file/$Par
    }
    return $Final
}

#deep level procedure used only by pdbStore
#
# pdbBuild - this routine takes an array and makes sure storage
# exists in the local parameter space to write into. Called
# only be pdbStore.
#
proc __pdbBuild {WriteDir ArrName} {
    global pdbHeaderFile

    #split the array name into pieces
    regsub -all & $ArrName " " list

    #the first one is special - we have to start somewhere
    set arr [lindex $list 0]
    if { ![file isdirectory $WriteDir/$arr] } {
	exec mkdir $WriteDir/$arr
	exec cp $pdbHeaderFile $WriteDir/$arr/Info
    }

    #drop the first element of the list
    set list [lrange $list 1 end]

    foreach dir $list {
	set arr [__pdbBuildNext $WriteDir $arr $dir]
    }

    #finally return the directory we've built
    regsub -all & $ArrName / file
    return $WriteDir/$file
}


#
# pdbDumpParams - this procedure writes all modified parameters 
# in array Array into the filename passed.  The array parameter must
# be an array!  Called only be pdbStore.
#
proc __pdbDumpParams {file Array} {
    global $Array pdbHeaderFile

    if { ![array exists $Array] } {
	error "Writing out non-existant array: $Array"
    }

    #put the header down...
    exec cp $pdbHeaderFile $file

    #open in append mode
    set f [open $file a]

    #get the modified parameters
    set list [lindex [array get $Array Modify] 1]
    foreach par $list {
	puts $f "array set \$Base \{[array get $Array $par]\}"
    }
    puts $f "return $list"

    close $f
}


#
# pdbGetSubArrays - This routine finds all unique arrays that are
# defined one level below the passed array name and returns that
# list.  Called only by pdbAllArrays.
#
proc __pdbGetSubArrays {Arr} {
    global $Arr
    set list ""

    set sid [array startsearch $Arr]
    while {[array anymore $Arr $sid]} {
	set val [array nextelement $Arr $sid]
	set val [lindex [array get $Arr $val] 1]
	if { [llength $val] == 1 } {
	    set tmp ${Arr}&${val}
	    global $tmp
	    if { [array exists $tmp] } {
		#array name - check for uniqueness
		if { [lsearch -exact $list $tmp] == -1 } { 
		    lappend list $tmp
		}
	    }
	}
    }
    return $list
}

#
# pdbAllArrays - This routine returns all the currently defined
# parameter arrays.  Called only by pdbStore.
#
proc __pdbAllArrays {} {
    set list Params
    set RetList Params

    while { [llength $list] != 0 } {
	set nextlist ""
	foreach arr $list {
	    set subs [__pdbGetSubArrays $arr]
	    set nextlist "$nextlist $subs"
	    set RetList "$RetList $subs"
	}
	set list $nextlist
    }
    return $RetList
}

#
# pdbSet - this sets a parameter value in the heirarchy.  (Note -
# permanance does not happen until a pdbStore command!) It updates
# the list of parameters modified, so that the pdbStore works
# correctly.  This routine assumes parameters are already stored
# correctly - users can get in trouble if they store things that
# do not follow convention.  Called by all the typed pdbSet 
# user functions.
#
proc __pdbSet {args} {
  #added ParamUserModify global array to keep track of changes -11/9/99 vikas 
  global ParamUserModify

    #get all but the last two arguments
    set len [llength $args]
    set Base [lindex $args 0]
    set arraylist [lrange $args 1 [expr $len-3]]
    set parname [lindex $args [expr $len-2]]
    set parval [lindex $args [expr $len-1]]
    set Array $Base

    #build the list of array names to check...
    foreach dcase $arraylist {
	set dir $dcase; #[string totitle $dcase]
	global $Array
	set chk [array get $Array $dir]

	if { [llength $chk] == 2 } {
	    set TmpA ${Array}&[lindex $chk 1]
	} else {
	    array set $Array "$dir $dir"
	    set TmpA ${Array}&$dir
	}

	global $TmpA

	#if it doesn't exist, try to create by reading it
	if { ![array exists $TmpA] } { __pdbReadParam $TmpA }

	#if it still doesn't exist, make it!
	if { ![array exists $TmpA] } { 
	    global $Array
	    array set $TmpA "Modify {}"
	}
	set Array $TmpA
    }

    #get the primary storage location
    set Arr [lindex $Array 0]
    global $Arr

    #before we set the value - read the defaults!
    if { ![array exists $Arr] } { __pdbReadParam $Arr }

    #set the value only into the first array - not the likes
    array set $Arr "$parname [list $parval]"

#************* 11/9/99 vikas ***********************************
# changes made to pdbset to keep track of parameter modifications
# array name = ParamUserModify
# element = Arrayname+listname = Params&Insulator&Arsenic&Abs.Error
# elment value = new value  
#	       = Params Insulator Arsenic Abs.Error {Double 4}

   #create ParamUserModify array
   set Melement $Arr&$parname
   #track change 
   array set ParamUserModify "$Melement {$args}" 

# end changes made to pdbset
#************ 11/9/99 vikas *************************************

    #add the name to the list of locally modified variables
    set list [lindex [array get $Arr Modify] 1]
    #has the parameter name already been modified
    if { [lsearch -exact $list $parname] == -1 } {
        lappend list $parname
        array set $Arr "Modify [list $list]"
    }
}


#
# pdbCheckType - This routine matches types against the type stored.
# If the asked for parameter matches the Type this returns the value.
# If there is a mismatch, this returns a tcl error which will abort
# the operation.  Called by all the pdbGet typed used functions.
#
proc __pdbCheckType { Par Type arglist } {
    #now make sure we match the return of the existing variable, if present
    set ret [catch {eval __pdbGet $Par $arglist} a]
    if { ! $ret } {
	set type [lindex $a 0]
	if { [string compare $type $Type] } {
	    error "Conflicting Types - existing variable is type $type"
	}
    } else {
	return "Nonexistant 0"
    }
    return $a;
}

#
# pdbSetType - This routine determines if it is ok to set the variable
# passed to the passed type.  It is ok if the variable doesn't exist,
# or if the type is the same.  
# Called by all the user pdbSet Type functions.
#
proc __pdbSetCheck { Type args } {
    set Base [lindex $args 0]
    set arglist [lrange $args 1 end]
    #now make sure we match the return of the existing variable, if present
    if { ! [catch {eval __pdbGet $Base $arglist} a] } {
	set type [lindex $a 0]
	if { [string compare $type $Type] } {
	    error "Conflicting Types - existing variable is type $type"
	}
    }
    return $a;
}
