source: trunk/graceexport.tcl @ 1124

# tcl code that attempts to duplicate a BLT graph in XMGRACE
# (see http://plasma-gate.weizmann.ac.il/Grace/)
# this was written by John Cowgill and later hacked by Brian Toby
# to deal with un-recognized colors, export markers, warn on old BLT versions
# & brace expressions (seems faster?)

proc output_grace { graph_name "title {}" "subtitle {}"} {
    global blt_version
    # trap pre 2.4 BLT versions, where options have different names
    # but beware, really old versions of blt don't have a version number
    if [catch {set blt_version}] {set blt_version 0}
    if {$blt_version <= 2.3 || $blt_version == 8.0} {
        # version 8.0 is ~same as 2.3
        tk_dialog .tooOld "Old BLT" \
                "Sorry, you are using a version of BLT that is too old for this routine" \
                "" 0 OK
        return
    }
    set element_count 0

    # define translation tables
    array set grace_colormap {
        black 1 red 2 green 3 blue 4 yellow 5 brown 6 gray 7 purple 8 \
                cyan 9 magenta 10 orange 11
    }
    array set grace_symbols {
        none 0 circle 1 square 2 diamond 3 triangle 4 arrow 6 plus 8 splus 8 \
                cross 9 scross 9
    }
    
    # general header stuff
    set output_string "# Grace project file\n#\n@version 50010\n"
    
    # loop through each element in the graph but reverse order, so that
    # elements on the bottom are done first
    set element_list [$graph_name element names] 
    set index [llength $element_list]
    while {[incr index -1] >= 0} {
        set element_name [lindex $element_list $index]
        set element_cmd "$graph_name element cget $element_name"
        
        # get xy data for this element
        set data_list [eval $element_cmd -data]
        
        #if there is no data, skip this set as Grace does not like null sets
        if {[llength $data_list] == 0} continue

        # write the legend name for this element
        append output_string "@s$element_count legend \"" \
                [eval $element_cmd -label] "\"\n"

        # get the color and symbol type for this element
        set color_data 1
        catch {
            set color_data $grace_colormap([eval $element_cmd -color])
        }
        append output_string "@s$element_count line color $color_data\n" \
                "@s$element_count errorbar color $color_data\n" \
                "@s$element_count symbol color $color_data\n"
        set symbol_data 1
        catch {
            set symbol_data $grace_symbols([eval $element_cmd -symbol])
        }
        append output_string "@s$element_count symbol $symbol_data\n"
        # fill defaults to symbol color
        catch {
            set color_data $grace_colormap([eval $element_cmd -fill])
        }
        append output_string "@s$element_count symbol fill color $color_data\n"

        # get element symbol/line width/size settings
        set size_data [eval $element_cmd -linewidth]
        append output_string \
                "@s$element_count linewidth $size_data\n" \
                "@s$element_count symbol linewidth $size_data\n"
        # turn off the line, if the width is zero
        if {$size_data == 0} {
            append output_string \
                    "@s$element_count line type 0\n" 
        }

        # approximate the BLT size in grace
        set size_data 1
        catch {
            set size_data [expr {[eval $element_cmd -pixels]/15.0}]
        }
        append output_string "@s$element_count symbol size $size_data\n" \
                "@s$element_count symbol fill pattern 1\n"

        # check if this element is hidden or not
        set hidden_data [eval $element_cmd -hide]
        if {[string compare "1" $hidden_data] == 0} {
            append output_string "@s$element_count hidden true\n"
        } else {
            append output_string "@s$element_count hidden false\n"
        }

        # check to see if there is -edata defined for this element
        # should work for versions of BLT that do not support -edata
        if {[catch \
                "$graph_name element configure $element_name -edata" edata_list] || \
                [string compare "" [lindex $edata_list 4]] == 0} {
            # no error data present, just use xy data
            append output_string "@s$element_count errorbar off\n@type xy\n"
            set max [expr {[llength $data_list] / 2}]
            for {set i 0} {$i < $max} {incr i} {
                append output_string [lindex $data_list [expr {2*$i}]] " " \
                        [lindex $data_list [expr {2*$i + 1}]] "\n"
            }
        } else {
            # error data present, check for error vector
            set edata_list [lindex $edata_list 4]
            if {[llength $edata_list] == 1} {
                # found a vector name instead of a list, so get the values
                set edata_list [$edata_list range 0 end]
            }
            # get xy data for this element
            set data_list [eval $element_cmd -data]
            set max [expr {[llength $data_list] / 2}]
            if {[llength $edata_list] >= [expr {[llength $data_list] * 2}]} {
                append output_string \
                        "@s$element_count errorbar on\n@type xydxdxdydy\n"
                for {set i 0} {$i < $max} {incr i} {
                    append output_string [lindex $data_list  [expr {2*$i + 0}]] " " \
                            [lindex $data_list  [expr {2*$i + 1}]] " " \
                            [lindex $edata_list [expr {4*$i + 2}]] " " \
                            [lindex $edata_list [expr {4*$i + 3}]] " " \
                            [lindex $edata_list [expr {4*$i + 0}]] " " \
                            [lindex $edata_list [expr {4*$i + 1}]] "\n"
                }
            } else {
                append output_string \
                        "@s$element_count errorbar on\n@type xydy\n"
                for {set i 0} {$i < $max} {incr i} {
                    append output_string [lindex $data_list [expr {2*$i}]] " " \
                            [lindex $data_list [expr {2*$i + 1}]] " " \
                            [lindex $edata_list $i] "\n"
                }
            }
        }
        append output_string "&\n"
        incr element_count
    }

    # general graph header stuff
    append output_string "@with g0\n"
    
    # get x and y axis limits
    foreach v {x y} {
        set limit_data [$graph_name ${v}axis limits]
        set ${v}min [lindex $limit_data 0]
        set ${v}max [lindex $limit_data 1]
        append output_string "@world ${v}min [set ${v}min]\n"
        append output_string "@world ${v}max [set ${v}max]\n"
    }
    
    # get legend information from graph
    set legend_data [lindex [$graph_name legend configure -hide] 4]
    if {[string compare "1" $legend_data] == 0} {
        append output_string "@legend off\n"
    } else {
        append output_string "@legend on\n"
    }

    # get title of graph
    if {$title == ""} {
        set title [$graph_name cget -title]
    }
    append output_string \
            "@title \"$title\"\n" \
            "@subtitle \"$subtitle\"\n"
    
    # get labels for x and y axes
    foreach z {x y} {
        set axistitle [$graph_name ${z}axis cget -title]
        set ticklist [$graph_name ${z}axis cget -majorticks]
        set tickspace [expr {[lindex $ticklist 1] - [lindex $ticklist 0]}]
        set minorticks [expr {$tickspace / (1 + \
                [llength [$graph_name ${z}axis cget -minorticks]])}]
        append output_string \
                "@${z}axis label \"$axistitle\"\n" \
                "@${z}axis tick major $tickspace\n" \
                "@${z}axis tick minor $minorticks\n"
    }
    
    # check for log scale on either axis
    set log_data [lindex [$graph_name xaxis configure -logscale] 4]
    if {[string compare "1" $log_data] == 0} {
        append output_string "@xaxes scale Logarithmic\n"
    }
    set log_data [lindex [$graph_name yaxis configure -logscale] 4]
    if {[string compare "1" $log_data] == 0} {
        append output_string "@yaxes scale Logarithmic\n"
    }

    # now get graph markers
    foreach m [$graph_name marker names] {
        if {[$graph_name marker type $m] == "line" || \
                [$graph_name marker type $m] == "LineMarker"} {
            set coords [$graph_name marker cget $m -coords]
            if {[$graph_name marker cget $m -dashes] == {}} {
                set linestyle 1
            } else {
                set linestyle 3
            }
            set color_data 1
            catch {
                set color_data $grace_colormap([$graph_name marker cget $m -outline])
            }

            if {[lindex $coords 0] < $xmin || [lindex $coords 0] > $xmax} \
                    continue 
            regsub -all -- "\\+Inf" $coords $ymax coords
            regsub -all -- "-Inf" $coords $ymin coords
            while {[llength $coords] >= 4} {
                set c [lindex $coords 0]
                foreach c1 [lrange $coords 1 3] {append c ", $c1"}
                append output_string \
                        "@with line\n" \
                        "@ line on\n@ line loctype world\n@ line g0\n" \
                        "@ line $c\n" \
                        "@ line linewidth 1.0\n@ line linestyle $linestyle\n" \
                        "@ line color $color_data\n@ line arrow 0\n" \
                        "@line def\n"
                set coords [lrange $coords 2 end]
            }
        } elseif {[$graph_name marker type $m] == "text" || \
                      [$graph_name marker type $m] == "TextMarker"} {
            set coords [$graph_name marker cget $m -coords]
            # leave a 5% margin for markers on plot limits
            set aymax [expr {$ymax - 0.05 * ($ymax - $ymin)}]
            set aymin [expr {$ymin + 0.05 * ($ymax - $ymin)}]
            regsub -all -- "\\+Inf" $coords $aymax coords
            regsub -all -- "-Inf" $coords $aymin coords 
            set c "[lindex $coords 0], [lindex $coords 1]"
            set text [$graph_name marker cget $m -text]
            set just [$graph_name marker cget $m -anchor]
            if {[string range $just 0 0] == "c"} {
                set center 2
            } elseif {[string range $just 0 0] == "n"} {
                set center 10
            } elseif {[string range $just 0 0] == "e"} {
                # is this correct?
                set center 0
            } else {
                set center 1
            }
            set color_data 1
            catch {
                set color_data $grace_colormap([$graph_name marker cget $m -fg])
            }
            set angle [$graph_name marker cget $m -rotate]

            append output_string \
                    "@with string\n" \
                    "@ string on\n@ string loctype world\n@ string g0\n" \
                    "@ string color $color_data\n@ string rot $angle\n" \
                    "@ string just $center\n" \
                    "@ string $c\n@ string def \"$text\"\n"
        }
    }    
    return $output_string
}