source: trunk/gnuplot.tcl @ 1251

Last change on this file since 1251 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
File size: 8.5 KB
Line 
1proc Graph2CSV {graph_name csvname  {initialComment 1}} {
2    if { [catch {set fp [open $csvname w]}] } {
3        if { [file isfile $csvname] } {
4            MyMessageBox -parent . -title "Cannot write to file" \
5                -message  "Write access to $csvname is denied.  File may be opened by another program, or directory may be write protected.  Try closing programs, or changing your current working directory" \
6            -type OK -default ok
7        } else {
8            MyMessageBox -parent . -title "No write access" \
9                -message "This directory does not have write access, you much change your current working directory" \
10                -type OK -default ok
11        }
12        return 1
13    }
14    set commas {}
15    set element_list [$graph_name element show] 
16
17    set heading "" 
18    set num 0
19    catch {unset data_list}
20    set max 0
21    foreach element_name $element_list {
22        set element_cmd "$graph_name element cget $element_name"
23        # get xy data for this element
24        set data_list($num) [eval $element_cmd -data]
25        #if there is no data, skip this set
26        set pts [llength $data_list($num)]
27        if {$pts > $max} {set max $pts}
28        if {[llength $data_list($num)] == 0} continue
29        incr num
30        if {$heading != ""} {append heading ","}
31        append heading  [$graph_name axis cget x -title]
32        append heading ","
33        append heading $element_name
34    }
35    #For Gnuplot exports, the column labels need to be commented out
36    if {$initialComment} {
37        puts $fp "#$heading"
38    } else {
39        puts $fp $heading
40    }
41    for {set i 0} {$i < $max} {incr i 2} {
42        set line ""
43        for {set n 0} {$n < $num} {incr n} {
44        # get xy data for this element
45            foreach {x y} [lrange $data_list($n) $i [expr {$i + 1}]] {}
46            append line "$x,$y,"
47        }
48        puts $fp $line
49    }
50    close $fp
51    return 0
52}
53
54proc Graph2Gnuplot {graph_name gplotname psname csvname "legendplace 1"} {
55    if {[Graph2CSV $graph_name $csvname]} {return 1}
56    if { [catch {set gplotfp [open $gplotname w]}] } {
57        MyMessageBox -parent . -title "Cannot write to file" \
58            -message  "Write access to $gplotname is denied.  File may be opened by another program, or directory may be write protected.  Try closing programs, or changing your current working directory" \
59            -type OK -default ok
60        return 1
61    }
62    puts $gplotfp "set datafile separator \",\"\n"
63    puts $gplotfp "set terminal postscript"
64    puts $gplotfp "set output \"$psname\""
65   
66    # use the title font size throughout
67    set fontsize [lindex [$graph_name cget -font] 1]
68    if {$fontsize != ""} {
69        if {$fontsize < 0} {
70            set fontsize ",[expr {-$fontsize}] "
71        } else {
72            set fontsize ",$fontsize "
73        }
74    }
75
76    if {$::tcl_platform(platform) != "windows"} { 
77        set font "\"Helvetica$fontsize\""
78    } else { 
79        set font "font \"Arial$fontsize\"" 
80    }
81    puts $gplotfp "set term postscript landscape color solid $font size 10.5in,7.5in enhanced\n"
82    puts $gplotfp "set xtics border out \nset ytics border out"
83    puts $gplotfp "set mxtics 5\nset mytics 5\n"
84   
85    #turns out that an opaque key is brand new in the gnuplot dev version 4.5.  This is what Windows ships with, but for now, unix systems will have to do without.  Too bad
86    if {$::tcl_platform(platform) == "windows"} { puts $gplotfp "set key opaque" }
87    if {$legendplace == 0 } { puts $gplotfp "set key out" }
88    if {[$graph_name legend cget -hide]} {puts $gplotfp "set key off\n" }
89
90    set title [$graph_name cget -title]
91    if { $title != "" } {
92        regsub -all "\"" $title "\\\"" thetitle
93        puts $gplotfp "set title \"$thetitle\""
94    }
95       
96    set xlab [$graph_name axis cget x -title]
97    if {[string match -nocase $xlab "2theta"]} {set xlab "2{/Symbol q}"}
98    puts $gplotfp "\nset xlabel \"$xlab\""
99    puts $gplotfp "set ylabel \"[$graph_name axis cget y -title]\""
100       
101    puts $gplotfp "\nset origin -0.05,0.025"
102
103    foreach {xmin xmax} [$graph_name xaxis limits] {}
104    foreach {ymin ymax} [$graph_name yaxis limits] {}
105    puts $gplotfp "set xrange \[ ${xmin}:${xmax} \]"
106       
107    set yoff [expr ($ymax-$ymin)*0.02]
108    set yminauto [expr $ymin-$yoff]
109    set ymaxauto [expr $ymax+$yoff]
110       
111    set line "set yrange \[";
112    if {[$graph_name yaxis cget -min] == "" } { 
113        append line "$yminauto:" 
114    } else { 
115        append line "$ymin:" 
116    }
117    if {[$graph_name yaxis cget -max] == "" } { 
118        append line "$ymaxauto\]\n" 
119    } else { 
120        append line "$ymax\]\n" 
121    }   
122    puts $gplotfp $line
123
124    puts $gplotfp "set style line 1 lt 1 lw 2" 
125    # it would be nice to control this for each figure
126    puts $gplotfp "set pointsize 1.75" 
127
128    set plotline "plot "
129    set i 0
130    set element_list [$graph_name element show]
131
132    set heading "" 
133    foreach element_name $element_list {
134        set element_cmd "$graph_name element cget $element_name"
135        #if there is no data, skip this set
136        if {[llength [eval $element_cmd -data]] == 0} continue
137        if {$plotline != "plot "} { append plotline "\\\n   , " }
138
139        # get line info from plot -- not currently used
140        set lw [eval $element_cmd -linewidth]
141        set symbol  [eval $element_cmd -symbol]
142        set size  [eval $element_cmd -pixels]
143        set dash  [eval $element_cmd -dashes]
144        #puts "$element_name $symbol"
145        if {$lw >= 1 && $symbol == "none"} {
146            append plotline "\"$csvname\" using [expr 2*$i+1]:[expr 2*$i+2] with lines ls 1 lc rgbcolor "
147        } elseif {$lw >= 1 && $symbol != "none"}  {
148            # don't know how to control symbol type or size line by line
149            append plotline "\"$csvname\" using [expr 2*$i+1]:[expr 2*$i+2] with linespoints ls 1 lc rgbcolor "
150        } else {
151            append plotline "\"$csvname\" using [expr 2*$i+1]:[expr 2*$i+2] with points ls 1 lc rgbcolor "      }
152        # get color
153        set linecolor [eval $element_cmd -color]
154        # convert 16 bit color to 3x8 bit digit RGB value
155        set str "#"
156        foreach rgb [winfo rgb . $linecolor] {
157            append str [format "%02X" [expr {$rgb / 256}]]
158        }
159        append plotline {"} $str {"}
160
161        append plotline " title \""
162        set plotlbl [eval $element_cmd -label]
163        #if {$plotlbl == ""} {set plotlbl $element_name}
164        regsub -all "\"" [string trim $plotlbl] "\\\"" thetitle
165        append plotline $thetitle;
166        append plotline "\""
167        incr i
168    }
169
170    # loop over markers
171    foreach mrk [$graph_name marker names] {
172        set type [$graph_name marker type $mrk]
173        if {$type == "TextMarker"} {
174            set txt [$graph_name marker cget $mrk -text]
175            set angle [$graph_name marker cget $mrk -rotate]
176            set coords [$graph_name marker cget $mrk -coords]
177            set justify [$graph_name marker cget $mrk -justify]
178            set anchor [$graph_name marker cget $mrk -anchor]
179            set color [$graph_name marker cget $mrk -foreground]
180            # convert 16 bit color to 3x8 bit digit RGB value
181            set str "#"
182            foreach rgb [winfo rgb . $color] {
183                append str [format "%02X" [expr {$rgb / 256}]]
184            }
185            # deal with text placement -- anchor/justify not quite mapped
186            set place "left"
187            if {$anchor == "center"} {
188                set place "center"
189            } elseif {[string first "w" $anchor]} {
190                set place "right"
191            }
192
193            # text rotation
194            set rot {}
195            if {$angle != 0.0 && $angle != ""} {
196                set rot "rotate by $angle" 
197            }
198            # text location
199            foreach val $coords var {x1 y1} \
200                min [list $xmin $ymin] max [list $xmax $ymax] {
201                    if {$val == "+Inf"} {
202                        set $var $max
203                    } elseif {$val == "-Inf"} {
204                        set $var $min
205                    } else {
206                        set $var $val
207                    }
208                }
209            if {$x1 < $xmin || $x1 > $xmax} {continue}
210            # replace newlines
211            regsub -all "\n" $txt {\n} txt
212            puts $gplotfp "set label \"$txt\" at first $x1,$y1 tc rgbcolor \"$str\" $place $rot" 
213        } elseif {$type == "LineMarker"} {
214            set coords [$graph_name marker cget $mrk -coords]
215            #set lw [$graph_name marker cget $mrk -linewidth]
216            #set dashes [$graph_name marker cget $mrk -dashes]
217            set linecolor [$graph_name marker cget $mrk -outline]
218            # convert 16 bit color to 3x8 bit digit RGB value
219            set str "#"
220            foreach rgb [winfo rgb . $linecolor] {
221                append str [format "%02X" [expr {$rgb / 256}]]
222            }
223            foreach val $coords var {x1 y1 x2 y2} \
224                min [list $xmin $ymin $xmin $ymin] max [list $xmax $ymax $xmax $ymax] {
225                    if {$val == "+Inf"} {
226                        set $var $max
227                    } elseif {$val == "-Inf"} {
228                        set $var $min
229                    } else {
230                        set $var $val
231                    }
232                }
233            if {$x1 < $xmin || $x2 > $xmax} {continue}
234            puts $gplotfp "set arrow from first $x1,$y1 to first $x2,$y2 nohead lc rgbcolor \"$str\"" 
235        } else {
236            puts "unable to process marker $mrk of type $type"
237        }
238    }
239    # last item, do plot command
240    puts $gplotfp $plotline
241    close $gplotfp
242    return 0
243}
244set gnuplotexport "loaded"
Note: See TracBrowser for help on using the repository browser.