File Coverage

lib/Graphics/Fig.pm

Criterion	Covered	Total	%
statement	344	444	77.4
branch	43	98	43.8
condition	1	9	11.1
subroutine	38	40	95.0
pod	24	25	96.0
total	450	616	73.0

#
# XFig Drawing Library
#
# Copyright (c) 2017 D Scott Guthridge
#
# This program is free software: you can redistribute it and/or modify it under
# the terms of the Artistic License as published by the Perl Foundation, either
# version 2.0 of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the Artistic License for more details.
#
# You should have received a copy of the Artistic License along with this
# program.  If not, see .
#
package Graphics::Fig;
our $VERSION = 'v1.0.8';

use strict;
use warnings;
use Carp;
use File::Temp qw/ tempfile /;
use Graphics::Fig::Color;
use Graphics::Fig::Matrix;
use Graphics::Fig::Parameters;
use Graphics::Fig::Arc;
use Graphics::Fig::Compound;
use Graphics::Fig::Ellipse;
use Graphics::Fig::Polyline;
use Graphics::Fig::Spline;
use Graphics::Fig::Text;

my $FIG2DEV = "fig2dev";

#
# Graphics::Fig::_figPerInch return fig units per inch
#   $parameters
#
sub _figPerInch {
    my $parameters = shift;
    my $unitSystem = ${$parameters}{"units"}[1];

    if ($unitSystem eq "Metric") {
	return 1143.0;	#  450 fig units/cm
    } else {
	return 1200.0;	# 1200 fig units/in
    }
}

#
# Graphics::Fig::convertEndAction
#   $fig:     Fig instance
#   $prefix:  error message prefix
#   $value:   end action
#   $context: parameter context
#
sub convertEndAction {
    my $fig     = shift;
    my $prefix  = shift;
    my $value   = shift;
    my $context = shift;

    if ($value eq "merge" || $value eq "group" || $value eq "discard") {
	return $value;
    }
    croak("${prefix}: ${value}: error: expected Landscape or Portrait");
}

#
# Global Parameters
#
my %GlobalParameterTemplate = (
    positional	=> {
    },
    named	=> [
	\%Graphics::Fig::Parameters::UnitsParameter,	# must be first
	\%Graphics::Fig::Parameters::PositionParameter,	# must be second
	 @Graphics::Fig::Parameters::ArrowParameters,
	\%Graphics::Fig::Parameters::CapStyleParameter,
	\%Graphics::Fig::Parameters::ColorParameter,
	\%Graphics::Fig::Parameters::CornerRadiusParameter,
	\%Graphics::Fig::Parameters::DepthParameter,
	\%Graphics::Fig::Parameters::DetachedLinetoParameter,
	 @Graphics::Fig::Parameters::ExportParameters,
	 @Graphics::Fig::Parameters::FillParameters,
	\%Graphics::Fig::Parameters::GridParameter,
	\%Graphics::Fig::Parameters::JoinStyleParameter,
	 @Graphics::Fig::Parameters::LineParameters,
	 @Graphics::Fig::Parameters::SaveParameters,
	\%Graphics::Fig::Parameters::SplineSubtypeParameter,
	 @Graphics::Fig::Parameters::TextParameters,
    ],
);

#
# Export Parameters
#
my %ExportParameterTemplate = (
    positional	=> {
	"."	=> [ "filename" ],
    },
    named	=> [
	\%Graphics::Fig::Parameters::UnitsParameter,	# must be first
	\%Graphics::Fig::Parameters::PositionParameter,	# must be second
	 @Graphics::Fig::Parameters::SaveParameters,
	{
	    name	=> "filename",
	},
	{
	    name	=> "exportFormat",	# duplicated for alias
	    aliases	=> [ "format" ],
	},
	{
	    name	=> "exportOptions",	# duplicated for alias
	    aliases	=> [ "options" ],
	    convert	=> \&Graphics::Fig::Parameters::convertExportOptions,
	},
    ],
);

#
# Move Parameters
#
my %MovetoParameterTemplate = (
    positional	=> {
	"@"  => [ "point" ],
	".." => [ "distance", "heading" ],
    },
    named	=> [
	\%Graphics::Fig::Parameters::UnitsParameter,	# must be first
	\%Graphics::Fig::Parameters::PositionParameter,	# must be second
	\%Graphics::Fig::Parameters::PointParameter,
	{
	    name		=> "distance",
	    convert		=> \&Graphics::Fig::Parameters::convertLength,
	},
	{
	    name		=> "heading",
	    convert		=> \&Graphics::Fig::Parameters::convertAngle,
	},
    ],
);

#
# Translate Parameters
#
my %TranslateParameterTemplate = (
    positional	=> {
	"@" => [ "offset" ],
    },
    named	=> [
	\%Graphics::Fig::Parameters::UnitsParameter,	# must be first
	\%Graphics::Fig::Parameters::OffsetParameter,
    ],
);

#
# Rotate Parameters
#
my %RotateParameterTemplate = (
    positional	=> {
	"." => [ "rotation" ],
    },
    named	=> [
	\%Graphics::Fig::Parameters::UnitsParameter,	# must be first
	\%Graphics::Fig::Parameters::PositionParameter,	# must be second
	\%Graphics::Fig::Parameters::CenterParameter,
	\%Graphics::Fig::Parameters::RotationParameter,
    ],
);

#
# Scale Parameters
#
my %ScaleParameterTemplate = (
    positional	=> {
	"." => [ "scale" ],
	"@" => [ "scale" ],
    },
    named	=> [
	\%Graphics::Fig::Parameters::UnitsParameter,	# must be first
	\%Graphics::Fig::Parameters::PositionParameter,	# must be second
	\%Graphics::Fig::Parameters::CenterParameter,
	\%Graphics::Fig::Parameters::ScaleParameter,
    ],
);

#
# End Parameters
#
my %EndParameterTemplate = (
    positional	=> {
	"."	=> [ "action" ],
    },
    named	=> [
	\%Graphics::Fig::Parameters::UnitsParameter,	# must be first
	\%Graphics::Fig::Parameters::PositionParameter,	# must be second
	\%Graphics::Fig::Parameters::GridParameter,
	{
	    name	=> "action",
	    convert	=> \&convertEndAction,
	    default	=> "merge",
	},
    ],
);

##
## Load Parameters
##
#my %LoadParameterTemplate = (
#    positional	=> {
#	"."	=> [ "filename" ],
#    },
#    named	=> [
#	{
#	    name	=> "filename",
#	},
#    ],
#);

#
# Save Parameters
#
my %SaveParameterTemplate = (
    positional	=> {
	"."	=> [ "filename" ],
    },
    named	=> [
	\%Graphics::Fig::Parameters::UnitsParameter,	# must be first
	\%Graphics::Fig::Parameters::PositionParameter,	# must be second
	 @Graphics::Fig::Parameters::SaveParameters,
	{
	    name	=> "filename",
	},
    ],
);

#
# Get Position and Get Bounding Box Parameters
#
my %UnitsOnlyParameterTemplate = (
    positional	=> {
    },
    named	=> [
	\%Graphics::Fig::Parameters::UnitsParameter,	# must be first
    ],
);

#
# Graphics::Fig::new: constructor
#   $proto:   prototype
#   [ { option1=value1, option2=value2, ... } ]
#
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $self = {
	colors	=> Graphics::Fig::Color->new(),
	stack	=> [
	    {
		options		=> { },
		objects		=> [ ],
		openLineto	=> undef,
		openSplineto	=> undef,
	    },
	],
    };
    bless($self, $class);
    $self->options({});

    #
    # Process global options.
    #
    my $stack = ${$self}{"stack"};
    my $tos = ${$stack}[$#{$stack}];
    eval {
	Graphics::Fig::Parameters::parse($self, "Graphics::Fig::new",
					 \%GlobalParameterTemplate,
					 undef, ${$tos}{"options"}, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }

    return $self;
}

#
# Graphics::Fig::options: change global options
#   $self:    class instance
#   [ { option1=value1, option2=value2, ... } ]
#
sub options {
    my $self = shift;
    my $stack = ${$self}{"stack"};
    my $tos   = ${$stack}[$#{$stack}];

    eval {
	Graphics::Fig::Parameters::parse($self, "options",
					 \%GlobalParameterTemplate,
					 ${$tos}{"options"},
					 ${$tos}{"options"}, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    return 1;
}

#
# Graphics::Fig::moveto move to a new position
#   $self:    class instance
#   moveto options...
#
sub moveto {
    my $self = shift;
    my $stack = ${$self}{"stack"};
    my $tos = ${$stack}[$#{$stack}];
    my $options = ${$tos}{"options"};
    my %parameters;
    my $newPosition;

    eval {
	Graphics::Fig::Parameters::parse($self, "moveto",
					 \%MovetoParameterTemplate, $options,
					 \%parameters, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    if (defined($parameters{"point"})) {
	if (defined($parameters{"distance"})) {
	    croak("moveto error: point and distance cannot be given together");
	}
	if (defined($parameters{"heading"})) {
	    croak("moveto error: point and heading cannot be given together");
	}
	$newPosition = $parameters{"point"};

    } elsif (defined(my $r = $parameters{"distance"})) {
	my $theta = $parameters{"heading"};
	if (!defined($theta)) {
	    croak("moveto error: expected point, or distance and heading");
	}
	$newPosition = [ $parameters{"position"}[0] + $r * cos($theta),
			 $parameters{"position"}[1] - $r * sin($theta) ];

    } elsif (defined($parameters{"position"})) {
	$newPosition = $parameters{"position"};

    } else {
	croak("moveto error: point and distance cannot be given together");
    }
    ${$options}{"position"} = $newPosition;

    return 1;
}

#
# Graphics::Fig::getposition: return the current position
#   $self:    class instance
#
sub getposition {
    my $self = shift;
    my $stack = ${$self}{"stack"};
    my $tos = ${$stack}[$#{$stack}];
    my $options = ${$tos}{"options"};
    my %parameters;
    my $position;
    my $scale;

    eval {
	Graphics::Fig::Parameters::parse($self, "getposition",
		\%UnitsOnlyParameterTemplate, $options, \%parameters, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    $scale    = $parameters{"units"}[0];
    $position = ${$options}{"position"};
    return [ ${$position}[0] / $scale, ${$position}[1] / $scale ];
}

#
# Graphics::Fig::begin: begin a sub-environment
#   $self:    class instance
#   [ { } ]
#
sub begin {
    my $self = shift;
    my $stack = ${$self}{"stack"};
    my $tos = ${$stack}[$#{$stack}];
    my %parameters;

    eval {
	Graphics::Fig::Parameters::parse($self, "begin",
					 \%GlobalParameterTemplate,
					 ${$tos}{"options"},
					 \%parameters, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    push(@{$stack}, {
	options		=> \%parameters,
	objects		=> [ ],
	openLineto	=> undef,
	openSplineto	=> undef,
    });

    return 1;
}

#
# Graphics::Fig::end: end a sub-environment
#   $self:    class instance
#   [ [ action ] { action={merge|group|discard} }
#
sub end {
    my $self = shift;
    my %parameters;

    my $stack  = ${$self}{"stack"};
    my $oldTos = pop(@{$stack});
    my $tos = ${$stack}[$#{$stack}];


    eval {
	Graphics::Fig::Parameters::parse($self, "end", \%EndParameterTemplate,
					 ${$tos}{"options"}, \%parameters,
					 @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    if ($parameters{"action"} eq "merge") {
	push(@{${$tos}{"objects"}}, @{${$oldTos}{"objects"}});

    } elsif ($parameters{"action"} eq "group") {
	my $objects = ${$oldTos}{"objects"};
	Graphics::Fig::Compound->new($self, $objects, \%parameters);
    }
    return 1;
}

#
# Graphics::Fig::arc draw an arc
#   $self:    class instance
#   arc parameters...
#
sub arc {
    my $self = shift;
    my $obj = eval {
	return Graphics::Fig::Arc->arc($self, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    return $obj;
}

#
# Graphics::Fig::arc draw an arc
#   $self:    class instance
#   arc parameters...
#
sub arcto {
    my $self = shift;
    my $obj = eval {
	return Graphics::Fig::Arc->arcto($self, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    return $obj;
}

#
# Graphics::Fig::circle: draw a circle
#   $self:    class instance
#   circle parameters...
#
sub circle {
    my $self = shift;
    my $obj = eval {
	return Graphics::Fig::Ellipse->circle($self, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    return $obj;
}

#
# Graphics::Fig::ellipse: draw an ellipse
#   $self:    class instance
#   ellipse parameters...
#
sub ellipse {
    my $self = shift;
    my $obj = eval {
	return Graphics::Fig::Ellipse->ellipse($self, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    return $obj;
}

#
# Graphics::Fig::polyline: draw a polyline object
#   $self:    class instance
#   polyline parameters...
#
sub polyline {
    my $self = shift;
    my $obj = eval {
	return Graphics::Fig::Polyline->polyline($self, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    return $obj;
}

#
# Graphics::Fig::lineto: draw a line from position to the given point(s)
#   $self:    class instance
#   polyline parameters...
#
sub lineto {
    my $self = shift;
    my $obj = eval {
	return Graphics::Fig::Polyline->lineto($self, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    return $obj;
}

#
# Graphics::Fig::box draw a box object
#   $self:    class instance
#   box parameters...
#
sub box {
    my $self = shift;
    my $obj = eval {
	return Graphics::Fig::Polyline->box($self, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    return $obj;
}

#
# Graphics::Fig::polygon draw a polygon object
#   $self:    class instance
#   polygon parameters...
#
sub polygon {
    my $self = shift;
    my $obj = eval {
	return Graphics::Fig::Polyline->polygon($self, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    return $obj;
}

#
# Graphics::Fig::picture embed a picture
#   $self:    class instance
#   picture parameters...
#
sub picture {
    my $self = shift;
    my $obj = eval {
	return Graphics::Fig::Polyline->picture($self, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    return $obj;
}

#
# Graphics::Fig::spline: draw a spline
#   $self:    class instance
#   picture parameters...
#
sub spline {
    my $self = shift;
    my $obj = eval {
	return Graphics::Fig::Spline->spline($self, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    return $obj;
}

#
# Graphics::Fig::splineto: draw a spline from current point
#   $self:    class instance
#   picture parameters...
#
sub splineto {
    my $self = shift;
    my $obj = eval {
	return Graphics::Fig::Spline->splineto($self, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    return $obj;
}

#
# Graphics::Fig::text add text
#   $self:    class instance
#   text parameters...
#
sub text {
    my $self = shift;
    my $obj = eval {
	return Graphics::Fig::Text->text($self, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    return $obj;
}

#
# Graphics::Fig::translate: translate all objects
#   $self:    class instance
#   translate parameters...
#
sub translate {
    my $self = shift;

    my $stack = ${$self}{"stack"};
    my $tos   = ${$stack}[$#{$stack}];
    my %parameters;
    eval {
	Graphics::Fig::Parameters::parse($self, "translate",
					 \%TranslateParameterTemplate,
					 ${$tos}{"options"}, \%parameters, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    foreach my $object (@{${$tos}{"objects"}}) {
	$object->translate(\%parameters);
    }
}

#
# Graphics::Fig::rotate: rotate all objects
#   $self:    class instance
#   rotate parameters...
#
sub rotate {
    my $self = shift;

    my $stack = ${$self}{"stack"};
    my $tos   = ${$stack}[$#{$stack}];
    my %parameters;
    eval {
	Graphics::Fig::Parameters::parse($self, "translate",
					 \%RotateParameterTemplate,
					 ${$tos}{"options"}, \%parameters, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    foreach my $object (@{${$tos}{"objects"}}) {
	$object->rotate(\%parameters);
    }
}

#
# Graphics::Fig::scale: scale all objects
#   $self:    class instance
#   scale parameters...
#
sub scale {
    my $self = shift;

    my $stack = ${$self}{"stack"};
    my $tos   = ${$stack}[$#{$stack}];
    my %parameters;
    eval {
	Graphics::Fig::Parameters::parse($self, "translate",
					 \%ScaleParameterTemplate,
					 ${$tos}{"options"}, \%parameters, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    foreach my $object (@{${$tos}{"objects"}}) {
	$object->scale(\%parameters);
    }
}

#
# Graphics::Fig::getbbox return the bounding box of all objects
#   $self:    class instance
#   bbox parameters...
#
sub getbbox {
    my $self = shift;

    my $stack = ${$self}{"stack"};
    my $tos   = ${$stack}[$#{$stack}];
    my $options = ${$tos}{"options"};
    my %parameters;
    my $scale;
    my ($x_min, $y_min, $x_max, $y_max);
    eval {
	Graphics::Fig::Parameters::parse($self, "getbbox",
		\%UnitsOnlyParameterTemplate, $options, \%parameters, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }
    foreach my $object (@{${$tos}{"objects"}}) {
	my $bbox = $object->getbbox(\%parameters);
	if (!defined($x_min)) {
	    $x_min = ${$bbox}[0][0];
	    $y_min = ${$bbox}[0][1];
	    $x_max = ${$bbox}[1][0];
	    $y_max = ${$bbox}[1][1];
	    next;
	}
	if (${$bbox}[0][0] < $x_min) {
	    $x_min = ${$bbox}[0][0];
	}
	if (${$bbox}[0][1] < $y_min) {
	    $y_min = ${$bbox}[0][1];
	}
	if (${$bbox}[1][0] > $x_max) {
	    $x_max = ${$bbox}[1][0];
	}
	if (${$bbox}[1][1] > $y_max) {
	    $y_max = ${$bbox}[1][1];
	}
    }
    $scale = $parameters{"units"}[0];
    return [ [ $x_min / $scale, $y_min / $scale ],
             [ $x_max / $scale, $y_max / $scale ] ];
}

# TODO: Implement load.
#
# Load would allow you to incorporate existing figures, manipulate
# them using translate, rotate and scale, form groups around them
# and superimpose new objects over them.
#
# Notes:
# - Some older formats should be accepted.  Documented versions are: 1.3, 1.4,
#   1.5 1.6, 2.0, 2.1, 3.0, 3.1 and 3.2.  Version 1.4 was the first to have a
#   #FIG line.  Versions 1.5 and 1.6 seem to have been a dead-end side
#   development path.
#
#   These are the preambles to a few formats:
#
#   1.3:
#     [no #FIG line]
#     resolution in pixels per inch
#     origin: 2
#     canvas width (pixels)
#     canvas height (pixels)
#
#   1.4:
#     #FIG line was added in this version
#     resolution
#     coordinate_system: 2
#
#   2.0:
#     resolution
#     coordinate_system: 2
#
#   3.1:
#     resolution: 1200
#     orientation: Landscape or Portrait
#     justification: Center or Flush Left
#     units: Metric or Inches
#     coordinate_system: 2
#
#   3.2:
#     orientation: Landscape or Portrait
#     justification: Center or Flush Left
#     units: Metric or Inches
#     papersize: Letter Legal Ledger Tabloid A B C D E A4 A3 A2 A1 A0 B5
#     magnification:
#     multiple-page: Single or Multiple
#     transparent color:
#     resolution coordinate_system: 1200 2
#
# - One approach would be to load the file into the current drawing
#   environment, mapping any new custom colors to new values.  Another approach
#   would be to construct a new Graphics::Fig object and provide a "merge"
#   function that merges one Fig object into another.  The later has the
#   benefit of providing merge, which may be useful in itself.  Like load,
#   merge also has to reassign color map entries.
#
## Graphics::Fig::load: load a .fig file into the current drawing environment
##   $self:    class instance
##   load parameters...
##
#sub load {
#    my $self = shift;
#
#    my $stack = ${$self}{"stack"};
#    my $tos   = ${$stack}[$#{$stack}];
#    my %parameters;
#    eval {
#	Graphics::Fig::Parameters::parse($self, "load", \%LoadParameterTemplate,
#					 ${$tos}{"options"}, \%parameters, @_);
#    };
#    if ($@) {
#	$@ =~ s/ at [^\s]* line \d+\.\n//;
#	croak("$@");
#    }
#
#    my $filename = $parameters{"filename"};
#    if (!defined($filename)) {
#	croak("load: error: expected filename");
#    }
#    my $fh;
#    open($fh, "<", $filename) || croak("save: $filename: $!");
#
#    if (!<$fh>) {
#	close($fh):
#	croak("load: error: can't read header line");
#    }
#    if (!/^#FIG (.*)/) {
#	close($fh):
#	croak("load: error: exepected FIG file format");
#    }
#
#    HERE
#
#    close($fh);
#}

#
# Graphics::Fig::_saveCommon: common code for save and export
#   $self:       class instance
#   $tos:        top of drawing stack
#   $parameters: reference to parameter hash
#   $fh:         open filehandle to the output file
#
sub _saveCommon {
    my $self       = shift;
    my $tos	   = shift;
    my $parameters = shift;
    my $fh	   = shift;

    my $figPerInch = _figPerInch($parameters);
    my $comment = ${$parameters}{"comment"};
    if ($comment ne "") {
	$comment =~ s/^/# /gm;
	if (!($comment =~ m/\n$/)) {
	    $comment .= "\n";
	}
    }
    printf $fh ("#FIG 3.2  Produced by Graphics::Fig\n");
    printf $fh ("%s\n", ${$parameters}{"orientation"});
    printf $fh ("%s\n", ${$parameters}{"pageJustification"});
    printf $fh ("%s\n", ${$parameters}{"units"}[1]);
    printf $fh ("%s\n", ${$parameters}{"paperSize"});
    printf $fh ("%.2f\n", ${$parameters}{"magnification"});
    printf $fh ("%s\n", ${$parameters}{"multiplePage"});
    printf $fh ("%d\n", ${$parameters}{"transparentColor"});
    if ($comment ne "") {
	printf $fh ("%s", $comment);
    }
    #
    # In the imperial unit system, 1200 is the number of fig units per
    # inch.  In metric, it's the number of fig units in 400/381 inches.
    # In other words, 1200 means 450 fig units per cm or exactly 1143
    # fig units per inch.
    #
    printf $fh ("1200 2\n");

    #
    # Add custom colors.
    #
    my $customHex = $self->{"colors"}->{"customHex"};
    for (my $i = 0; $i < scalar(@{$customHex}); ++$i) {
	printf $fh ("0 %d %s\n", 32 + $i, ${$customHex}[$i]);
    }

    #
    # Add objects.
    #
    foreach my $object (@{${$tos}{"objects"}}) {
	$object->print($fh, $parameters);
    }
}

#
# Graphics::Fig::save: save the .fig file
#   $self:    class instance
#   save parameters...
#
sub save {
    my $self = shift;

    my $stack = ${$self}{"stack"};
    my $tos   = ${$stack}[$#{$stack}];
    my %parameters;
    eval {
	Graphics::Fig::Parameters::parse($self, "save", \%SaveParameterTemplate,
					 ${$tos}{"options"}, \%parameters, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }

    my $filename = $parameters{"filename"};
    if (!defined($filename)) {
	croak("save: error: expected filename");
    }
    open(my $fh, ">", $filename) || croak("save: $filename: $!");
    &_saveCommon($self, $tos, \%parameters, $fh);
    close($fh);
}


#
# Graphics::Fig::export: export the drawing to the given format
#   $self:    class instance
#   save parameters...
#
sub export {
    my $self = shift;

    my $stack = ${$self}{"stack"};
    my $tos   = ${$stack}[$#{$stack}];
    my %parameters;
    eval {
	Graphics::Fig::Parameters::parse($self, "export",
					 \%ExportParameterTemplate,
					 ${$tos}{"options"}, \%parameters, @_);
    };
    if ($@) {
	$@ =~ s/ at [^\s]* line \d+\.\n//;
	croak("$@");
    }

    #
    # Validate parameters.  Determine the output format either from the
    # type argument or the filename extension.
    #
    my $outputFilename = $parameters{"filename"};
    if (!defined($outputFilename)) {
	croak("export: error: expected filename");
    }
    my $type;
    if (defined($parameters{"type"})) {
	$type = $parameters{"type"};
    } elsif ($outputFilename =~ m/\.([^.]+)$/) {
	$type = $1;
    } else {
	croak("export: error: cannot determine output file type");
    }

    #
    # Save the drawing to a temporary file.
    #
    my ($fh, $tempFilename) = tempfile();
    &_saveCommon($self, $tos, \%parameters, $fh);
    close($fh);

    #
    # Build the argument list and run fig2dev.
    #
    my @Args = ($FIG2DEV, "-L", $type);
    if (defined($parameters{"options"})) {
	push(@Args, @{$parameters{"options"}});
    }
    push(@Args, $tempFilename, $outputFilename);
    if ((system @Args) != 0) {
	croak("export: error: $!\n");
    }
}

1;

__END__