source: trunk/graceexport.tcl

Last change on this file was 1251, checked in by toby, 7 years ago

use svn ps svn:eol-style "native" * to change line ends

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Revision Id
File size: 9.0 KB
Line 
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
7proc 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] {
198        if {[$graph_name marker type $m] == "line" || \
199                [$graph_name marker type $m] == "LineMarker"} {
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            }
227        } elseif {[$graph_name marker type $m] == "text" || \
228                      [$graph_name marker type $m] == "TextMarker"} {
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 1
245            } else {
246                set center 0
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}
Note: See TracBrowser for help on using the repository browser.