Chart-Graph
view release on metacpan or search on metacpan
Graph/Xmgrace.pm view on Meta::CPAN
## Contact: graph-dev@caida.org
##
##
package Chart::Graph::Xmgrace;
use Exporter();
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw(&xmgrace);
use Carp; # for carp() and croak()
use Chart::Graph::Utils qw(:UTILS); # get global subs and variable
use Chart::Graph::XrtUtils qw(:UTILS);
use Chart::Graph::Xmgrace::Grace;
use Chart::Graph::Xmgrace::Graph_Presentation_Type;
use Chart::Graph::Xmgrace::Dataset;
use FileHandle;
$cvs_Id = '$Id: Xmgrace.pm,v 1.34 2006/06/07 21:09:33 emile Exp $';
$cvs_Author = '$Author: emile $';
$cvs_Name = '$Name: $';
$cvs_Revision = '$Revision: 1.34 $';
$VERSION = 3.2;
use strict;
#for debugging purposes.
my $stdout = 0;
# these variables hold default options for xmgrace
my %def_xmgrace_global_opts = (
"title" => "untitled", # @description
"subtitle" => "",
"type of graph" => "XY graph", # XY graph, XY chart, Polar Graph, Smith Chart, Fixed
"output type" => "PNG", # png, jpeg, ps
"output file" => "untitled-grace",
"grace output file" => "untitled-grace.agr",
"xrange" => undef,
"yrange" => undef,
"x-axis label" => "x-axis",
"y-axis label" => "y-axis",
"alt x-axis label" => undef,
"alt y-axis label" => undef,
"logscale x" => undef,
"logscale y" => undef,
"xtics" => undef,
"ytics" => undef,
"alt xtics" => undef,
"alt ytics" => undef,
"stacked" => "false",
"extra opts" => undef,
);
my $def_graph_appearance = new Chart::Graph::Xmgrace::Graph_Presentation_Type;
my %def_xmgrace_data_opts = (
"set presentation" => "XY",
"options" => $def_graph_appearance->{"XY graph"},
"title" => "untitled data set", # comment, legend
"data format" => undef, # columns, matrix, or file
);
# New Hash of array references to hold list of options that might need to
# be checked against options. If Xmgrace program changes. Update here
my %def_xmgrace_available_options =
( "type of graph" => ["XY graph", "XY chart", "Bar chart",
"Polar graph", "Smith chart", "Fixed",
# "Pie Chart", # Not yet implemented
],
);
#
#
# Subroutine: xmgrace()
#
# Description: this is the main function you will be calling from
# our scripts. please see
# www.caida.org/Tools/Graph/graph_xmgrace.html for a
# full description and how-to of this subroutine
#
sub xmgrace {
my ($user_global_opts_ref, @data_sets) = @_;
my (%data_opts, %global_opts,);
my ($plottype, $output_file, $plot_file, $output_type, $data_set_ref);
#my $autoscale = 1; # by default use autoscale
#my ($xscale, $yscale) = (0,0);
my $autoscale = "";
# create a new filehandle to be used throughout package
my $handle = new FileHandle;
my $grace_output_file;
my $grace = new Chart::Graph::Xmgrace::Grace("g0");
# create tmpdir
_make_tmpdir("_Xmgrace_"); # grace files should be saved for user tweaking
# set paths for external programs
if (not _set_xmgrace_paths()) {
_cleanup_tmpdir();
return 0;
}
# check first arg for hash
if (ref($user_global_opts_ref) ne "HASH") {
carp "Global options must be a hash";
_cleanup_tmpdir();
return 0;
}
# check for data sets
if (not @data_sets) {
carp "no data sets";
$handle->close;
_cleanup_tmpdir();
return 0;
}
Graph/Xmgrace.pm view on Meta::CPAN
my $dataset_count = 0;
while (@data_sets) {
$data_set_ref = shift @data_sets;
if (ref($data_set_ref) ne "ARRAY") {
carp "Data set must be an array";
$handle->close();
_cleanup_tmpdir();
return 0;
}
# create a new Dataset object with each new datase
my $data_set_object = new Chart::Graph::Xmgrace::Dataset;
my ($user_data_opts_ref, @data) = @{$data_set_ref};
# set values in the dataset object
$data_set_object->set_number($dataset_count);
$data_set_object->data(\@data);
# process data
$data_set_object->data_format($user_data_opts_ref->{"data format"});
my $formatted_data = _xmgrace_data_set($data_set_object);
if (not $formatted_data) {
# error message already printed
$handle->close();
_cleanup_tmpdir();
return 0;
}
# stick formatted data back in the dataset object
$data_set_object->data($formatted_data);
# set set_type
my $tog = $global_opts{"type of graph"}; # type of graph
if ($tog =~ "XY") {
$data_set_object->set_type("XY");
} elsif ($tog =~ m/BAR/i) {
$data_set_object->set_type("BAR");
} else {
carp "Untrapped graph type - Xmgrace.pm internal error";
}
# need to create a new Presentation Type object for each dataset
my $gpt = new Chart::Graph::Xmgrace::Graph_Presentation_Type($dataset_count);
my $graph_appearance = $gpt->{$global_opts{"type of graph"}};
$def_xmgrace_data_opts{options} = $graph_appearance;
# mesh data options
my $data_options_ref = _mesh_xmgrace_opts($user_data_opts_ref,
\%def_xmgrace_data_opts);
if (not $data_options_ref) {
# error message already printed
$handle->close();
_cleanup_tmpdir();
return 0;
}
# change the "title" into "comment" and "legend"
_set_title($data_options_ref);
# set data options in the dataset object
$data_set_object->options($data_options_ref);
# create new set presention for each data set
my $sp = $user_data_opts_ref->{"set presentation"};
if ($sp) {
if ($sp eq "XY") {
_set_XY($data_set_object);
} elsif ($sp =~ m/BAR/i) {
_set_BAR($data_set_object);
} else {
carp "Untrapped graph type - Xmgrace.pm internal error";
}
}
# process data
# accumulate data objects into an array.
push @cum_data_set_objects, $data_set_object;
$dataset_count++;
}
# print commandfile
if ($stdout) {
$handle = \*STDOUT;
}
$grace->print($handle);
# we're done crunching on the data now print something!
# print data options
foreach my $set_object (@cum_data_set_objects) {
# XXX This code breaks under Perl 5.6 - not sure why XXX
# $set_object->{options}->{options}->print($handle,"s" .
# "$set_object->{set_number}");
}
# print data sets
foreach my $set_object (@cum_data_set_objects) {
_printline($handle, "target G0.S$set_object->{\"set_number\"}\n");
_printline($handle, "type $set_object->{\"set_type\"}\n");
if (not _print_data_set($handle, $set_object)) {
# already printed error message
return 0;
}
}
# commandfile successfully completed
$handle->close unless ($stdout);
# if user chooses to, can save the .agr file
if (defined $grace->{grace_output_file}) {
_copy_commandfile($command_file, $grace->{grace_output_file});
}
# run xmgrace with commandline args to create the specified graph type
# $xmgrace needs to be defined in the user's script
Graph/Xmgrace.pm view on Meta::CPAN
return 1;
}
}
for ($i = 0; $i <= $length; $i++) {
print $handle "$delimeter", "$x_col->[$i]", "$delimeter",
"$y_col->[$i]\n";
}
# each data set is separated by a "&"
print $handle "&\n";
return 1;
}
#
# Name: _set_BAR
#
# Description: sets up the necessary characteristics of a BAR
# dataset type
#
sub _set_BAR ($ ) {
my $ds_object = shift;
my $data_options_ref = $ds_object->{options};
$ds_object->set_type("BAR");
$data_options_ref->{options}->type("BAR");
$data_options_ref->{options}->symbol->fill_pattern("1");
$data_options_ref->{options}->symbol->color("1");
$data_options_ref->{options}->line->type("0");
return 1;
}
#
# Name: _set_XY
#
# Description: sets up the necessary characteristics of an XY
# dataset type
#
sub _set_XY ($ ) {
my $ds_object = shift;
my $data_options_ref = $ds_object->{options};
$ds_object->set_type("XY");
$data_options_ref->{options}->type("XY");
$data_options_ref->{options}->symbol->fill_pattern("0");
$data_options_ref->{options}->line->type("1");
return 1;
}
# Name: _set_title
#
# Description: sets up the necessary characteristics for the
# title of the graph
#
sub _set_title ($ ) {
my $ds_ref = shift;
my $title = $ds_ref->{title};
$ds_ref->{options}->{options}->{comment} = $title;
$ds_ref->{options}->{options}->{legend} = $title;
return 1;
}
####################################################################
#
# The following functions are used to map an option value from
# prose to it's corresponding number value which grace understands
# Note: these routines are not used in the current version. the user
# must use numbers (NOT prose) for now.
#
###################################################################
#
# Subroutine: _get_color()
#
# Description: simply looks up a hash table and returns
# a number that xmgrace understands that
# corresponds to the color
#
sub _get_color ($ ) {
my $color = shift;
my %colortable = (
"white" => "0",
"black" => "1",
"red" => "2",
"green" => "3",
"blue" => "4",
"yellow" => "5",
"brown" => "6",
"grey" => "7",
"violet" => "8",
"cyan" => "9",
"magenta" => "10",
"orange" => "11",
"indigo" => "12",
"maroon" => "13",
"turquoise" => "14",
"green4" => "15",
);
$color = lc($color);
# "\L$color\E"
#color =~ y/A-Z/a-z/;
my $retval = $colortable{$color};
if ($retval) {
return $retval;
} else {
return 0;
}
}
#
# Subroutine: _get_symbol()
#
# Description: simply looks up a hash table and returns
# a number that xmgrace understands that
# corresponds to the symbol
( run in 0.840 second using v1.01-cache-2.11-cpan-e1769b4cff6 )