#! /opt/blt2.3/bin/bltwish -f

set pdbPath $env(FLXSHOME)
set brwPath $env(FLXSHOME)/Params
source $pdbPath/Params/pdb
source $brwPath/dialog
source $brwPath/Sdialog
#source $brwPath/savlod


#we have to do these here because they got recoded into c for speed
#
# pdbParseNext - create the next level of hierarchy from the stored
# parameter space.  If the hierarchy doesn't exist, it is read in.
# Returns a list of places to look for the next parameter in
# priority order.  A list is returned so that the Like property
# can be handled efficiently.  This is somewhat the inverse of
# pdbBuildNext. Called only be pdbGet.
#
proc __pdbParseNext {ArrList Par} {
    foreach Arr $ArrList {
        global $Arr
        if { ![array exists $Arr] } { __pdbReadParam $Arr }

        #look for the parameter directly here!
        set chk [array get $Arr $Par]
        if { [llength $chk] == 2 } {
            lappend RetList ${Arr}&[lindex $chk 1]
        }

        #look and see if this is like something else
        set chk [array get $Arr Like]
        while { [llength $chk] == 2 } {
            #replace the last element with the one this is like
            set foo [split $Arr &]
            set tmp [lreplace $foo [expr [llength $foo]-1] end [lindex $chk 1]]
            regsub -all " " $tmp {\&} Larr
            global $Larr
            if { ![array exists $Larr] } { __pdbReadParam $Larr }
            set chk [array get $Larr $Par]
            if { [llength $chk] == 2 } {
                lappend RetList ${Larr}&[lindex $chk 1]
            }
            set chk [array get $Larr Like]
        }
    }
    if {![info exists RetList]} {
        error "No Such Entry \"$Par\" in Hierarchy Below \"$ArrList\""
    }
    return $RetList
}


#
# pdbGet - retrieves a parameter from the listed heirarchy.  If
# necessary, the heirarchy is read in using pdbReadParam.  The list
# of places to search is built using pdbParseNext.  This implements
# the Like property.  The first value found is returned, which allows
# overrides.  Called by the user typed versions.  Users shouldn't call
# this directly because it returns the raw string without parsing, and
# there is no type checking.  Called only __pdbCheckType
#
proc __pdbGet {ParBase args} {
    #get all but the last argument
    set len [llength $args]
    set arraylist [lrange $args 0 [expr $len-2]]
    set parname [lindex $args [expr $len-1]]
    set Array $ParBase
    if { ![array exists $Array] } { __pdbReadParam $Array }

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

    foreach dir $Array {
        global $dir
        #read in the array if it doesn't exist
        if { ![array exists $dir] } { __pdbReadParam $dir }

        #if the array exists (some in a Like chain may not!)
        if { [array exists $dir] } {
            set val [array get $dir $parname]
            if { [llength $val] == 2 } {
                return [lindex $val 1]
            }
        }
    }
    error "Parameter \"$parname\" Not Found"
}


table .

wm title . "Property Data Base Browser"

# create a menu bar and menus
#**********************************************************************
frame .mbar1 -relief groove -borderwidth 2
pack .mbar1
menubutton .mbar1.file -text File -menu .mbar1.file.m

#create file menu
menu .mbar1.file.m
.mbar1.file.m add command -label "Open" -command {__LoadUserValues}
.mbar1.file.m add command -label "Save" -command {__SavetoFile}
.mbar1.file.m add command -label "Quit" -command {quit}
pack .mbar1.file -side left

#create functions menu
menubutton .mbar1.funct -text Functions -menu .mbar1.funct.m
menu .mbar1.funct.m
.mbar1.funct.m add command -label "Edit" -command {edit}
.mbar1.funct.m add command -label "Eval" -command {evaluate}
.mbar1.funct.m add command -label "Plot" -command {plot}
pack .mbar1.funct -side left 
  
table . \
  .mbar1 0,0
table configure . .mbar1 -anchor w -padx 3 -pady 1 -fill x
table configure . r0 -height 0.5i -resize none   
#***********************************************************************

# creates the home, back and forward buttons in row0 col1
#********************************************************************** 
frame .mbar2
pack .mbar2
  
    button .mbar2.home -text "Home" -command {home}
    button .mbar2.back -text "Back" -command {backlevel}
    button .mbar2.forwrd -text "Forward" -command {enterlevel}
  pack .mbar2.home .mbar2.back .mbar2.forwrd -side left -padx 1 -fill x -expand 1
  
table . \
  .mbar2 0,1
table configure . .mbar2 -anchor e -fill x 
#**********************************************************************

# creates the listbox and scroll bar in row1 col0
#**********************************************************************
frame .box
listbox .box.lbox -yscroll ".box.vscroll set" -relief sunken -width 25 -height 35 -setgrid yes -selectmode single
scrollbar .box.vscroll -command ".box.lbox yview"
pack .box.lbox -side left
pack .box.vscroll -side left -fill y

table . \
  .box 1,0 
table configure . .box -padx 3 -pady 2
table configure . r1 -height 6i -resize none
table configure . .box -reqheight {6i 8i}
#**********************************************************************

#create a frame for the status display and graph
#**********************************************************************
frame .c  
pack .c 
#**********************************************************************

# creates the arrayname, value, evaluated value, and type display
#**********************************************************************
frame .c.status 
	
	frame .c.status.array 
	label .c.status.array.array -text "Array: " 
	label .c.status.array.arrayname -textvariable ArrayName -width 45 -anchor w
	pack .c.status.array.array -side left -fill x
	pack .c.status.array.arrayname -side left -fill x 
	
	frame .c.status.type
	label .c.status.type.type -text "Type: "
	label .c.status.type.typename -textvariable TypeName -width 35 -anchor w
	pack .c.status.type.type -side left -anchor w -fill x
	pack .c.status.type.typename -side left -fill x 
	
	frame .c.status.value 
	label .c.status.value.value -text "Value: "
	message .c.status.value.valuename -textvariable ValueName -width 7c -anchor w
	pack .c.status.value.value -side left -fill x
	pack .c.status.value.valuename -side left -fill x 
	
	frame .c.status.evalue
	label .c.status.evalue.evalue -text "Evaluated Value : "
	message .c.status.evalue.evaluename -textvariable EvalVal -width 7c -anchor w
	pack .c.status.evalue.evalue -side left
	pack .c.status.evalue.evaluename -side left -fill x
	
	pack .c.status.array .c.status.type .c.status.value .c.status.evalue -anchor w

pack .c.status -anchor nw -expand 1
#**********************************************************************	

#creates the graph 
#**********************************************************************	

  graph .c.graph -plotbackground black 
  vector xVec yVec
    xVec set {700 700 700 700 700}
    yVec set {0 0 0 0 0}
    .c.graph axis configure y -logscale yes
    .c.graph axis configure x -title "1000.0/Temp" -titlecolor white 
    #-titlefont Helvetica
    .c.graph axis configure y -title "log value" -titlecolor white 
    #-titlefont Helvetica
 pack .c.graph -anchor s
#**********************************************************************	
 
#put frame of status display and graph in col1 row1 of the table
#**********************************************************************	    
table . \
  .c 1,1
table configure . .c -anchor nw -pady 2 -fill both -padx 2
table configure . c1 -resize none
#**********************************************************************	

# initiallization of the commands
#**********************************************************************
set ArrayName "Params"
set ParamUserModifyBool 0
__pdbReadParam Params ; #read the params directory, create one if it does not exsist
#**********************************************************************

#fill in the list box with top level commands
#**********************************************************************
proc __pdbFillList {Arr} {
  global $Arr

  #dummylists to keep track of elements and their values
  set valuelist {}
  set namelist {}

  #clear the list box
  .box.lbox delete 0 end

  #start a new array search
  set sid [array startsearch $Arr]
  while {[array anymore $Arr $sid]} {
    set val [array nextelement $Arr $sid]
    if { [string compare $val Modify] } {
	#get the value type of the element
	set x [lindex [array get $Arr $val] 1]
	if {[lsearch -exact $valuelist $x] == -1} {
	  #value type not in list, so add to valuelist.
	  if {$x == $val || [llength $x] !=1} {
	    #add only those strings whose element=value, or eval type
	    lappend valuelist $x
	    #add element to namelist for later sorting
	    lappend namelist $val}
     	}
    }
  }
  array donesearch $Arr $sid

  # sort the element list and insert into list box
  set sortedlist [lsort $namelist]
  for {set i 0} { $i <= [llength $sortedlist]} {incr i} {
	.box.lbox insert end [lindex $sortedlist $i]}
}
#**********************************************************************

__pdbFillList Params ; #fill in the list box

#define bindings for the list box
#**********************************************************************
bind .box.lbox <ButtonPress> {
  global TypeName ValueName EvalVal ArrayName IsArray
  regsub -all " " $ArrayName {\&} Arr
  global $Arr
  
  #where was the key pressed
  set y %y
  set indx [.box.lbox nearest $y]
  .box.lbox selection set $indx
  
  #get the selection point
  set point [.box.lbox get $indx]

  #get the current array value
  set tmp [lindex [array get $Arr $point] 1]
  
  #if the selected item contains more than 1 element  
  if {[llength $tmp] !=1} {
    set TypeName [lindex $tmp 0]
    set ValueName [lindex $tmp 1]
    set EvalVal ""
    .mbar2.forwrd configure -state disabled    
  }  else {
             set TypeName Array
             set ValueName $tmp
             set EvalVal ""
             .mbar2.forwrd configure -state normal
     }
}
#**********************************************************************


#function for the enter button
#**********************************************************************
proc enterlevel {} {
  global ArrayName EvalVal ValueName TypeName
  
  
  #get the selected array name
  regsub -all " " $ArrayName {\&} Arr
  set Array ${Arr}&$ValueName
  global $Array
  
  
  #change the display variable
  set ArrayName "$ArrayName $ValueName"
  
  #if the array has not been read, then do so
  if {![array exists $Array]} {__pdbReadParam $Array}
  __pdbFillList $Array
  
   set error [.c.graph element exist line1]
  
  if { $error==1} {
      .c.graph element delete line1
  }
  
  .mbar2.back configure -state normal
  set TypeName ""
  set ValueName ""
  set EvalVal ""
}
#**********************************************************************


#function for the back button
#**********************************************************************
proc backlevel {} {
  global ArrayName TypeName EvalVal ValueName
  
  #get the selected array name
  set depth [regsub -all " " $ArrayName {\&} Arr]
  
  if {$depth==0} {
    __pdbFillList Params
    .mbar2.back configure -state disabled
  } else {
            set ArrayName [lrange $ArrayName 0 [expr [llength $ArrayName]-2]]
            regsub -all " " $ArrayName {\&} Arr
            __pdbFillList $Arr
    }
  
  set error [.c.graph element exist line1]
  
  if { $error==1} {
      .c.graph element delete line1
  }
    
  set TypeName ""
  set ValueName ""
  set EvalVal ""
}
#**********************************************************************
  

#function for the home button
#**********************************************************************
proc home {} {
  global ArrayName TypeName EvalVal ValueName
  __pdbFillList Params ; #fill in the list box
  
  set ArrayName "Params"
  set TypeName ""
  set ValueName ""
  set EvalVal ""
  
  .mbar2.back configure -state disabled
  
  set error [.c.graph element exist line1]
  
  if { $error==1} {
      .c.graph element delete line1
  }
}
#**********************************************************************

#function for the Eval button
#**********************************************************************
proc evaluate {} {
  global EvalVal ValueName
  
  simSetDouble Diffuse temp 1000.0
  set EvalVal "[expr $ValueName] at 1000.0"
}
#**********************************************************************

#function for quit button
#**********************************************************************
proc quit {} {

global ParamUserModifyBool

# if all modifications are saved then quit when user requests
# ParamUserModifyBool = 0 then no changes or changes saved
# ParamUserModifyBool = 1 then changes need to saved
if {!$ParamUserModifyBool} {
	exit
} else {
	# changes not saved. confirm the changes
	__QuitConfirm
}
}
#**********************************************************************

#function for the edit button
#**********************************************************************
proc edit {} {
  global ArrayName TypeName ValueName OldValue point ParamUserModifyBool
  
  if { $TypeName =="Array"} {
    tk_dialog .diag {Warning!} {Only Double and Switch type values can be changed.} {} {0} {Ok}
  }
  
  if { $TypeName =="Double"} {
    dialog  {Double Edit Box} {Type in the new value}
    set OldValue $ValueName
    set ParamUserModifyBool 1
  } 
  
  if { $TypeName =="Switch"} {
    Sdialog
    regsub -all " " $ArrayName {\&} Arr
    global $Arr
    set tmp [lindex [array get $Arr $point] 1]
    set tmp2 [lindex $tmp 2]
    set OldValue [lindex $tmp2 $ValueName]
    set ParamUserModifyBool 1
  }
  

}
#**********************************************************************

#function for the plot button
#**********************************************************************
proc plot {} {
  global ArrayName TypeName ValueName Diffuse
  global xVec yVec
  
  if { $TypeName =="Double"} {   
    set error [.c.graph element exist line1]
    
    if { $error==1} {
      .c.graph element delete line1
    }
        
    set i 0  

    foreach tmp {700.0 800.0 900.0 1000.0 1100.0} {
      simSetDouble Diffuse temp $tmp
      set v [expr $ValueName]
      set T [expr 1000.0 / $tmp]
      set xVec($i) $T
      set yVec($i) $v
      incr i
    }

    .c.graph element create line1 -label "" -xdata xVec -ydata yVec -symbol circle -pixel 3  -color red

  }
}
#**********************************************************************

#moved source code from paramFunc of function Arrhenius and Arr
#**********************************************************************
#define a procedure to help evaluate Arrhenius parameters inside diffusion
proc Arrhenius {pre act} {
    set temp [simGetDouble Diffuse temp]
    return [expr $pre * exp( -$act / (8.617383e-05 * ($temp +273.0)))]
}

proc Arr {pre act} {
    set temp [simGetDouble Diffuse temp]
    return [expr $pre * exp( -$act / (8.617383e-05 * ($temp +273.0)))]
}
#**********************************************************************
