Changeset 6021 for trunk/lang/tcl/scripts/library.tcl
- Timestamp:
- Feb 18, 2016, 4:13:14 PM (9 years ago)
- Location:
- trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk
- Property svn:mergeinfo changed
-
trunk/lang/tcl/scripts/library.tcl
r4181 r6021 70 70 } 71 71 set fname [file join $Rappture::installdir lib library.xml] 72 73 set fid [::open $fname r] 74 set info [read $fid] 75 close $fid 76 72 if { [catch { 73 set fid [::open $fname r] 74 set info [read $fid] 75 close $fid 76 } errs] != 0 } { 77 puts stderr "can't open \"$fname\": errs=$errs errorInfo=$errorInfo" 78 } 77 79 set stdlib [Rappture::LibraryObj ::#auto $info] 78 80 return $stdlib … … 83 85 } else { 84 86 # otherwise, try to open the file and create its LibraryObj 85 set fid [::open $fname r] 86 set info [read $fid] 87 close $fid 87 if { [catch { 88 set fid [::open $fname r] 89 set info [read $fid] 90 close $fid 91 } errs] != 0 } { 92 puts stderr "can't open \"$fname\": errs=$errs errorInfo=$errorInfo" 93 } 88 94 } 89 95 … … 215 221 public method remove {{path ""}} 216 222 public method xml {{path ""}} 223 public method uq_get_vars {{tfile ""}} 217 224 218 225 public method diff {libobj} … … 228 235 private variable _root 0 ;# non-zero => this obj owns document 229 236 private variable _document "" ;# XML DOM tree 230 private variable _node "" ;# node within 237 private variable _node "" ;# node within 231 238 } 232 239 … … 696 703 set otherv [Rappture::entities $libobj input] 697 704 705 # add UQ checking 706 lappend thisv uq.type uq.args 707 lappend otherv uq.type uq.args 708 698 709 # scan through values for this object, and compare against other one 699 710 foreach path $thisv { … … 717 728 lappend rlist + $path "" $oraw 718 729 } 730 719 731 return $rlist 720 732 } … … 771 783 set units [$libobj get $path.units] 772 784 if {"" != $units} { 773 set val [Rappture::Units:: convert $val \785 set val [Rappture::Units::mconvert $val \ 774 786 -context $units -to $units -units off] 775 787 } … … 1038 1050 return $rlist 1039 1051 } 1052 1053 # ---------------------------------------------------------------------- 1054 # USAGE: uq_get_vars [$tfile] 1055 # 1056 # Scans number nodes in the input section for UQ parameters. 1057 # 1058 # Returns a string in JSON so it can easily be passed to PUQ. Strips units 1059 # because PUQ does not need or recognize them. 1060 # 1061 # For example, 2 parameters, one gaussian and one uniform might return: 1062 # [["height","m",["gaussian",100,10,{"min":0}]],["velocity","m/s",["uniform",80,90]]] 1063 # 1064 # Returns "" if there are no UQ parameters. 1065 # 1066 # If tfile is specified, write a template file out. 1067 # ---------------------------------------------------------------------- 1068 itcl::body Rappture::LibraryObj::uq_get_vars {{tfile ""}} { 1069 set varout \[ 1070 set varlist [] 1071 1072 if {$tfile == ""} { 1073 set node $_node 1074 } else { 1075 set fid [::open $tfile r] 1076 set doc [dom parse [read $fid]] 1077 set node [$doc documentElement] 1078 close $fid 1079 } 1080 1081 set count 0 1082 set n [$node selectNodes /run/input//number] 1083 foreach _n $n { 1084 set x [$_n selectNodes current/text()] 1085 set val [$x nodeValue] 1086 if {[string equal -length 8 $val "uniform "] || 1087 [string equal -length 9 $val "gaussian "]} { 1088 1089 set vname [$_n getAttribute id] 1090 if {[lsearch $varlist $vname] >= 0} { 1091 continue 1092 } else { 1093 lappend varlist $vname 1094 } 1095 1096 if {$count > 0} { 1097 append varout , 1098 } 1099 incr count 1100 1101 set units "" 1102 set unode [$_n selectNodes units/text()] 1103 if {"" != $unode} { 1104 set units [$unode nodeValue] 1105 set val [Rappture::Units::mconvert $val \ 1106 -context $units -to $units -units off] 1107 } 1108 1109 set v \[\"$vname\",\"$units\", 1110 set fmt "\[\"%s\",%.16g,%.16g" 1111 set val [format $fmt [lindex $val 0] [lindex $val 1] [lindex $val 2]] 1112 append v $val 1113 1114 if {[string equal -length 9 [$x nodeValue] "gaussian "]} { 1115 set minv "" 1116 set min_node [$_n selectNodes min/text()] 1117 if {"" != $min_node} { 1118 set minv [$min_node nodeValue] 1119 if {$units != ""} { 1120 set minv [Rappture::Units::convert $minv -context $units -units off] 1121 } 1122 } 1123 1124 set maxv "" 1125 set max_node [$_n selectNodes max/text()] 1126 if {"" != $max_node} { 1127 set maxv [$max_node nodeValue] 1128 if {$units != ""} { 1129 set maxv [Rappture::Units::convert $maxv -context $units -units off] 1130 } 1131 } 1132 1133 if {$minv != "" || $maxv != ""} { 1134 append v ",{" 1135 if {$minv != ""} { 1136 append v "\"min\":$minv" 1137 if {$maxv != ""} {append v ,} 1138 } 1139 if {$maxv != ""} { 1140 append v "\"max\":$maxv" 1141 } 1142 append v "}" 1143 } 1144 } 1145 1146 if {$tfile != ""} { 1147 $x nodeValue @@[$_n getAttribute id] 1148 } 1149 append varout $v\]\] 1150 } 1151 } 1152 append varout \] 1153 1154 if {$tfile != ""} { 1155 set fid [open $tfile w] 1156 puts $fid "<?xml version=\"1.0\"?>" 1157 puts $fid [$node asXML] 1158 close $fid 1159 $doc delete 1160 } 1161 if {$varout == "\[\]"} {set varout ""} 1162 #puts "uq_get_vars returning $varout" 1163 return [list $varout $count] 1164 }
Note: See TracChangeset
for help on using the changeset viewer.