[531] | 1 | # tcl code that attempts to duplicate a BLT graph in XMGRACE |
---|
| 2 | # (see http://plasma-gate.weizmann.ac.il/Grace/) |
---|
| 3 | # this was written by John Cowgill and later hacked by Brian Toby |
---|
| 4 | # to deal with un-recognized colors, export markers, warn on old BLT versions |
---|
| 5 | # & brace expressions (seems faster?) |
---|
| 6 | |
---|
| 7 | proc output_grace { graph_name "title {}" "subtitle {}"} { |
---|
| 8 | global blt_version |
---|
| 9 | # trap pre 2.4 BLT versions, where options have different names |
---|
| 10 | # but beware, really old versions of blt don't have a version number |
---|
| 11 | if [catch {set blt_version}] {set blt_version 0} |
---|
| 12 | if {$blt_version <= 2.3 || $blt_version == 8.0} { |
---|
| 13 | # version 8.0 is ~same as 2.3 |
---|
| 14 | tk_dialog .tooOld "Old BLT" \ |
---|
| 15 | "Sorry, you are using a version of BLT that is too old for this routine" \ |
---|
| 16 | "" 0 OK |
---|
| 17 | return |
---|
| 18 | } |
---|
| 19 | set element_count 0 |
---|
| 20 | |
---|
| 21 | # define translation tables |
---|
| 22 | array set grace_colormap { |
---|
| 23 | black 1 red 2 green 3 blue 4 yellow 5 brown 6 gray 7 purple 8 \ |
---|
| 24 | cyan 9 magenta 10 orange 11 |
---|
| 25 | } |
---|
| 26 | array set grace_symbols { |
---|
| 27 | none 0 circle 1 square 2 diamond 3 triangle 4 arrow 6 plus 8 splus 8 \ |
---|
| 28 | cross 9 scross 9 |
---|
| 29 | } |
---|
| 30 | |
---|
| 31 | # general header stuff |
---|
| 32 | set output_string "# Grace project file\n#\n@version 50010\n" |
---|
| 33 | |
---|
| 34 | # loop through each element in the graph but reverse order, so that |
---|
| 35 | # elements on the bottom are done first |
---|
| 36 | set element_list [$graph_name element names] |
---|
| 37 | set index [llength $element_list] |
---|
| 38 | while {[incr index -1] >= 0} { |
---|
| 39 | set element_name [lindex $element_list $index] |
---|
| 40 | set element_cmd "$graph_name element cget $element_name" |
---|
| 41 | |
---|
| 42 | # get xy data for this element |
---|
| 43 | set data_list [eval $element_cmd -data] |
---|
| 44 | |
---|
| 45 | #if there is no data, skip this set as Grace does not like null sets |
---|
| 46 | if {[llength $data_list] == 0} continue |
---|
| 47 | |
---|
| 48 | # write the legend name for this element |
---|
| 49 | append output_string "@s$element_count legend \"" \ |
---|
| 50 | [eval $element_cmd -label] "\"\n" |
---|
| 51 | |
---|
| 52 | # get the color and symbol type for this element |
---|
| 53 | set color_data 1 |
---|
| 54 | catch { |
---|
| 55 | set color_data $grace_colormap([eval $element_cmd -color]) |
---|
| 56 | } |
---|
| 57 | append output_string "@s$element_count line color $color_data\n" \ |
---|
| 58 | "@s$element_count errorbar color $color_data\n" \ |
---|
| 59 | "@s$element_count symbol color $color_data\n" |
---|
| 60 | set symbol_data 1 |
---|
| 61 | catch { |
---|
| 62 | set symbol_data $grace_symbols([eval $element_cmd -symbol]) |
---|
| 63 | } |
---|
| 64 | append output_string "@s$element_count symbol $symbol_data\n" |
---|
| 65 | # fill defaults to symbol color |
---|
| 66 | catch { |
---|
| 67 | set color_data $grace_colormap([eval $element_cmd -fill]) |
---|
| 68 | } |
---|
| 69 | append output_string "@s$element_count symbol fill color $color_data\n" |
---|
| 70 | |
---|
| 71 | # get element symbol/line width/size settings |
---|
| 72 | set size_data [eval $element_cmd -linewidth] |
---|
| 73 | append output_string \ |
---|
| 74 | "@s$element_count linewidth $size_data\n" \ |
---|
| 75 | "@s$element_count symbol linewidth $size_data\n" |
---|
| 76 | # turn off the line, if the width is zero |
---|
| 77 | if {$size_data == 0} { |
---|
| 78 | append output_string \ |
---|
| 79 | "@s$element_count line type 0\n" |
---|
| 80 | } |
---|
| 81 | |
---|
| 82 | # approximate the BLT size in grace |
---|
| 83 | set size_data 1 |
---|
| 84 | catch { |
---|
| 85 | set size_data [expr {[eval $element_cmd -pixels]/15.0}] |
---|
| 86 | } |
---|
| 87 | append output_string "@s$element_count symbol size $size_data\n" \ |
---|
| 88 | "@s$element_count symbol fill pattern 1\n" |
---|
| 89 | |
---|
| 90 | # check if this element is hidden or not |
---|
| 91 | set hidden_data [eval $element_cmd -hide] |
---|
| 92 | if {[string compare "1" $hidden_data] == 0} { |
---|
| 93 | append output_string "@s$element_count hidden true\n" |
---|
| 94 | } else { |
---|
| 95 | append output_string "@s$element_count hidden false\n" |
---|
| 96 | } |
---|
| 97 | |
---|
| 98 | # check to see if there is -edata defined for this element |
---|
| 99 | # should work for versions of BLT that do not support -edata |
---|
| 100 | if {[catch \ |
---|
| 101 | "$graph_name element configure $element_name -edata" edata_list] || \ |
---|
| 102 | [string compare "" [lindex $edata_list 4]] == 0} { |
---|
| 103 | # no error data present, just use xy data |
---|
| 104 | append output_string "@s$element_count errorbar off\n@type xy\n" |
---|
| 105 | set max [expr {[llength $data_list] / 2}] |
---|
| 106 | for {set i 0} {$i < $max} {incr i} { |
---|
| 107 | append output_string [lindex $data_list [expr {2*$i}]] " " \ |
---|
| 108 | [lindex $data_list [expr {2*$i + 1}]] "\n" |
---|
| 109 | } |
---|
| 110 | } else { |
---|
| 111 | # error data present, check for error vector |
---|
| 112 | set edata_list [lindex $edata_list 4] |
---|
| 113 | if {[llength $edata_list] == 1} { |
---|
| 114 | # found a vector name instead of a list, so get the values |
---|
| 115 | set edata_list [$edata_list range 0 end] |
---|
| 116 | } |
---|
| 117 | # get xy data for this element |
---|
| 118 | set data_list [eval $element_cmd -data] |
---|
| 119 | set max [expr {[llength $data_list] / 2}] |
---|
| 120 | if {[llength $edata_list] >= [expr {[llength $data_list] * 2}]} { |
---|
| 121 | append output_string \ |
---|
| 122 | "@s$element_count errorbar on\n@type xydxdxdydy\n" |
---|
| 123 | for {set i 0} {$i < $max} {incr i} { |
---|
| 124 | append output_string [lindex $data_list [expr {2*$i + 0}]] " " \ |
---|
| 125 | [lindex $data_list [expr {2*$i + 1}]] " " \ |
---|
| 126 | [lindex $edata_list [expr {4*$i + 2}]] " " \ |
---|
| 127 | [lindex $edata_list [expr {4*$i + 3}]] " " \ |
---|
| 128 | [lindex $edata_list [expr {4*$i + 0}]] " " \ |
---|
| 129 | [lindex $edata_list [expr {4*$i + 1}]] "\n" |
---|
| 130 | } |
---|
| 131 | } else { |
---|
| 132 | append output_string \ |
---|
| 133 | "@s$element_count errorbar on\n@type xydy\n" |
---|
| 134 | for {set i 0} {$i < $max} {incr i} { |
---|
| 135 | append output_string [lindex $data_list [expr {2*$i}]] " " \ |
---|
| 136 | [lindex $data_list [expr {2*$i + 1}]] " " \ |
---|
| 137 | [lindex $edata_list $i] "\n" |
---|
| 138 | } |
---|
| 139 | } |
---|
| 140 | } |
---|
| 141 | append output_string "&\n" |
---|
| 142 | incr element_count |
---|
| 143 | } |
---|
| 144 | |
---|
| 145 | # general graph header stuff |
---|
| 146 | append output_string "@with g0\n" |
---|
| 147 | |
---|
| 148 | # get x and y axis limits |
---|
| 149 | foreach v {x y} { |
---|
| 150 | set limit_data [$graph_name ${v}axis limits] |
---|
| 151 | set ${v}min [lindex $limit_data 0] |
---|
| 152 | set ${v}max [lindex $limit_data 1] |
---|
| 153 | append output_string "@world ${v}min [set ${v}min]\n" |
---|
| 154 | append output_string "@world ${v}max [set ${v}max]\n" |
---|
| 155 | } |
---|
| 156 | |
---|
| 157 | # get legend information from graph |
---|
| 158 | set legend_data [lindex [$graph_name legend configure -hide] 4] |
---|
| 159 | if {[string compare "1" $legend_data] == 0} { |
---|
| 160 | append output_string "@legend off\n" |
---|
| 161 | } else { |
---|
| 162 | append output_string "@legend on\n" |
---|
| 163 | } |
---|
| 164 | |
---|
| 165 | # get title of graph |
---|
| 166 | if {$title == ""} { |
---|
| 167 | set title [$graph_name cget -title] |
---|
| 168 | } |
---|
| 169 | append output_string \ |
---|
| 170 | "@title \"$title\"\n" \ |
---|
| 171 | "@subtitle \"$subtitle\"\n" |
---|
| 172 | |
---|
| 173 | # get labels for x and y axes |
---|
| 174 | foreach z {x y} { |
---|
| 175 | set axistitle [$graph_name ${z}axis cget -title] |
---|
| 176 | set ticklist [$graph_name ${z}axis cget -majorticks] |
---|
| 177 | set tickspace [expr {[lindex $ticklist 1] - [lindex $ticklist 0]}] |
---|
| 178 | set minorticks [expr {$tickspace / (1 + \ |
---|
| 179 | [llength [$graph_name ${z}axis cget -minorticks]])}] |
---|
| 180 | append output_string \ |
---|
| 181 | "@${z}axis label \"$axistitle\"\n" \ |
---|
| 182 | "@${z}axis tick major $tickspace\n" \ |
---|
| 183 | "@${z}axis tick minor $minorticks\n" |
---|
| 184 | } |
---|
| 185 | |
---|
| 186 | # check for log scale on either axis |
---|
| 187 | set log_data [lindex [$graph_name xaxis configure -logscale] 4] |
---|
| 188 | if {[string compare "1" $log_data] == 0} { |
---|
| 189 | append output_string "@xaxes scale Logarithmic\n" |
---|
| 190 | } |
---|
| 191 | set log_data [lindex [$graph_name yaxis configure -logscale] 4] |
---|
| 192 | if {[string compare "1" $log_data] == 0} { |
---|
| 193 | append output_string "@yaxes scale Logarithmic\n" |
---|
| 194 | } |
---|
| 195 | |
---|
| 196 | # now get graph markers |
---|
| 197 | foreach m [$graph_name marker names] { |
---|
[883] | 198 | if {[$graph_name marker type $m] == "line" || \ |
---|
| 199 | [$graph_name marker type $m] == "LineMarker"} { |
---|
[531] | 200 | set coords [$graph_name marker cget $m -coords] |
---|
| 201 | if {[$graph_name marker cget $m -dashes] == {}} { |
---|
| 202 | set linestyle 1 |
---|
| 203 | } else { |
---|
| 204 | set linestyle 3 |
---|
| 205 | } |
---|
| 206 | set color_data 1 |
---|
| 207 | catch { |
---|
| 208 | set color_data $grace_colormap([$graph_name marker cget $m -outline]) |
---|
| 209 | } |
---|
| 210 | |
---|
| 211 | if {[lindex $coords 0] < $xmin || [lindex $coords 0] > $xmax} \ |
---|
| 212 | continue |
---|
| 213 | regsub -all -- "\\+Inf" $coords $ymax coords |
---|
| 214 | regsub -all -- "-Inf" $coords $ymin coords |
---|
| 215 | while {[llength $coords] >= 4} { |
---|
| 216 | set c [lindex $coords 0] |
---|
| 217 | foreach c1 [lrange $coords 1 3] {append c ", $c1"} |
---|
| 218 | append output_string \ |
---|
| 219 | "@with line\n" \ |
---|
| 220 | "@ line on\n@ line loctype world\n@ line g0\n" \ |
---|
| 221 | "@ line $c\n" \ |
---|
| 222 | "@ line linewidth 1.0\n@ line linestyle $linestyle\n" \ |
---|
| 223 | "@ line color $color_data\n@ line arrow 0\n" \ |
---|
| 224 | "@line def\n" |
---|
| 225 | set coords [lrange $coords 2 end] |
---|
| 226 | } |
---|
[883] | 227 | } elseif {[$graph_name marker type $m] == "text" || \ |
---|
| 228 | [$graph_name marker type $m] == "TextMarker"} { |
---|
[531] | 229 | set coords [$graph_name marker cget $m -coords] |
---|
| 230 | # leave a 5% margin for markers on plot limits |
---|
| 231 | set aymax [expr {$ymax - 0.05 * ($ymax - $ymin)}] |
---|
| 232 | set aymin [expr {$ymin + 0.05 * ($ymax - $ymin)}] |
---|
| 233 | regsub -all -- "\\+Inf" $coords $aymax coords |
---|
| 234 | regsub -all -- "-Inf" $coords $aymin coords |
---|
| 235 | set c "[lindex $coords 0], [lindex $coords 1]" |
---|
| 236 | set text [$graph_name marker cget $m -text] |
---|
| 237 | set just [$graph_name marker cget $m -anchor] |
---|
| 238 | if {[string range $just 0 0] == "c"} { |
---|
| 239 | set center 2 |
---|
| 240 | } elseif {[string range $just 0 0] == "n"} { |
---|
| 241 | set center 10 |
---|
| 242 | } elseif {[string range $just 0 0] == "e"} { |
---|
| 243 | # is this correct? |
---|
| 244 | set center 0 |
---|
| 245 | } else { |
---|
| 246 | set center 1 |
---|
| 247 | } |
---|
| 248 | set color_data 1 |
---|
| 249 | catch { |
---|
| 250 | set color_data $grace_colormap([$graph_name marker cget $m -fg]) |
---|
| 251 | } |
---|
| 252 | set angle [$graph_name marker cget $m -rotate] |
---|
| 253 | |
---|
| 254 | append output_string \ |
---|
| 255 | "@with string\n" \ |
---|
| 256 | "@ string on\n@ string loctype world\n@ string g0\n" \ |
---|
| 257 | "@ string color $color_data\n@ string rot $angle\n" \ |
---|
| 258 | "@ string just $center\n" \ |
---|
| 259 | "@ string $c\n@ string def \"$text\"\n" |
---|
| 260 | } |
---|
| 261 | } |
---|
| 262 | return $output_string |
---|
| 263 | } |
---|