UML::Sequence::Raster - converts xml sequence files to a raster image

    use UML::Sequence::Raster;

    seq2raster @ARGV;

 ([ I<options-pairs>, ] [input_file_name])

#2345678901234567890123456789012345678901234567890123456789012345678901234567890

package UML::Sequence::Raster;

use Exporter;
@ISA    = qw(Exporter);
@EXPORT = qw(seq2raster);

use XML::DOM;
use Getopt::Std;
use GD;
use GD qw(gdSmallFont gdLargeFont gdMediumBoldFont gdTinyFont gdGiantFont);
use GD::Text::Wrap;

if ($^O eq 'MSWin32') {
    require Win32::Font::NameToFile;
    import Win32::Font::NameToFile qw(get_ttf_abs_path get_ttf_bold  get_ttf_italic);
}

use strict;
use warnings;

our $VERSION = '0.01';

# Constant declarations.
my $CLASS_TEXT_Y      =  40;
my $CLASS_BOX_Y       =  25;
my $CLASS_BOX_HEIGHT  =  20;
my $CLASS_BOX_WIDTH   = 125;
my $CLASS_SPACING     =   3;

my $LEFT_EDGE         =  92;

my $ACTIVATION_WIDTH  =  15;
my $ACTIVATION_OFFSET =  10;

my $FIRST_ARROW       =  55;
my $ARROW_SPACING     =  60;
my $ARROW_DELTA       =  0;

use constant LINE_THICKNESS => 2;

use constant LEFT_ARROW => 0;
use constant RIGHT_ARROW => 1;
use constant HALF_LEFT_ARROW => 2;
use constant HALF_RIGHT_ARROW => 3;
my @arrowpts = (
[0, 0, 12, 6, 0, 14],
[0, 6, 12, 0, 12, 14],
[0, 4, 12, 4, 12, 14],
[0, 14, 12, 4, 0, 4],
);
my @arrows = ();

# Global variable:
my $output_file = "-";
my $classcolor = 'white';
my $actcolor = 'white';
my $docpath;            # path to assoc. classdocs
my $mappath;            # path to write areamap file
my $mapname;            # imagemap name derived from raster output filename
my $classcharwidth = 9; # width of class header characters
my $charwidth = 8;      # width of characters
my $charht = 10;        # height of characters
my $annot;              # annotations behavior:
                        # 'e' : embed in specified file;
                        # 'j' : apply javascript tooltips in specified file
                        # NOTE: specified file may be same as image map file
my $white;
my $black;

my %colors = (
    white    => [255,255,255],
    lgray    => [191,191,191],
    gray    => [127,127,127],
    dgray    => [63,63,63],
    black    => [0,0,0],
    lblue    => [0,0,255],
    blue    => [0,0,191],
    dblue    => [0,0,127],
    gold    => [255,215,0],
    lyellow    => [255,255,125],
    yellow    => [255,255,0],
    dyellow    => [127,127,0],
    lgreen    => [0,255,0],
    green    => [0,191,0],
    dgreen    => [0,127,0],
    lred    => [255,0,0],
    red        => [191,0,0],
    dred    => [127,0,0],
    lpurple    => [255,0,255],
    purple    => [191,0,191],
    dpurple    => [127,0,127],
    lorange    => [255,183,0],
    orange    => [255,127,0],
    pink    => [255,183,193],
    dpink    => [255,105,180],
    marine    => [127,127,255],
    cyan    => [0,255,255],
    lbrown    => [210,180,140],
    dbrown    => [165,42,42],
    transparent => [1,1,1]
);
#
#    font names
#
my $fontfile;
my $fontname;
my $titlefont;
my $classfont;
my $methodfont;
my $eventfont;
my $tinyfont;

my $sig;
#
#    caches of text elements, to optimize
#    rendering
#
my @class_hdrs = ();
my @classtext = ();
my @labeltext = ();
my @italtext = ();
my @supertext = ();

sub seq2raster {
    local (@ARGV) = @_;
    my $opts = parse_command_line();

    $classcolor = $opts->{c} || 'white';
    $actcolor = $opts->{a} || 'white';
    $docpath = $opts->{p} || $opts->{P};
    $mappath = $opts->{m} || $opts->{M};
    $charwidth = $opts->{x} || 6;
    $charht = $opts->{y} || 14;
    $CLASS_BOX_WIDTH = $opts->{w} || 125;
    $annot = $opts->{e} ? 'e' : $opts->{j} ? 'j' : undef;
    $fontfile = $opts->{F};
    $fontname = $opts->{f};
    $sig = $opts->{s};

    die "Annotation requested without output path."
        if ($annot && (! $mappath));

    $ARROW_SPACING = (index($opts->{g}, '.') >= 0) ?
        int($ARROW_SPACING * $opts->{g}) : $opts->{g}
        if $opts->{g};

    $docpath .= '/'
        if ($docpath && (substr($docpath, -1, 1) ne '/'));

    my $input_file = shift @ARGV;

    if (defined $input_file) {
        open INPUT, "$input_file"
            or die "Couldn't open $input_file for input: $!\n";
    }
    else {
        *INPUT = *STDIN;
    }
#
#    DAA Add HTML image map rendering
#
    my $mapfd;
    if (defined($mappath)) {
        $mappath = $opts->{M} ? ">>$mappath" : ">$mappath";
        die "Cannot open image map file $mappath: $!"
            unless open($mapfd, $mappath);
#
#    define a mapname from output file name (if any)
#
        $mapname = ($output_file=~/(\w+)\.\w+$/) ? $1 : 'mapname';
        print $mapfd
"<html>
<body>
<img border=0 src='$mapname\.png' usemap='#$mapname'>
<MAP NAME='$mapname'>
";
    }

    my $parser       = XML::DOM::Parser->new();
    my $doc          = $parser->parse(*INPUT);

    my $sequence     = $doc->getDocumentElement();
    my $title        = $sequence->getAttribute("title");

    my $classes      = $doc->getElementsByTagName("class");
#
#    DAA added to track previous class for drawing async arrows
#
    my %priors       = ();
    my $class_hash   = build_class_name_hash($classes);
    my $class_count  = scalar (keys %$class_hash);
#
#    if external events, but not first, then trim
#
    $class_count--
        if exists($class_hash->{_EXTERNAL}) && $class_hash->{_EXTERNAL};
#
#    compute class header text now, so we get get true box sizes
#
    my $maxClassHt = 1;
    while (my ($class, $idx) = each %$class_hash) {
        if ($class eq '_EXTERNAL') {
            $ARROW_DELTA = 1 if ($idx == 0);
            next;
        }
        $class_hdrs[$idx] = _wrapText($class);
        my $lines = ($class_hdrs[$idx]=~tr/\n//) + 1;
        $maxClassHt = $lines if ($lines > $maxClassHt);
    }
    $CLASS_BOX_HEIGHT *= $maxClassHt;
    $FIRST_ARROW = $CLASS_TEXT_Y + $CLASS_BOX_HEIGHT;

    my $arrow_count  = count_arrows($doc);
    my $width        = ($class_count + 0.5) *
        ($CLASS_BOX_WIDTH + $CLASS_SPACING) + 40;
    my $height       = $FIRST_ARROW + ($arrow_count + 1) * ($ARROW_SPACING);

    my $format = ($output_file eq '-') ? 'png' :
        ($output_file=~/\.(gif|jpg|jpeg|png)$/i) ? lc $1 : 'png';

    my $img = GD::Image->new($width, $height);
    $white = $img->colorAllocate(@{$colors{white}});
    $black = $img->colorAllocate(@{$colors{black}});
    $classcolor = ($classcolor eq 'black') ? $black :
        ($classcolor eq 'white') ? $white :
        (substr($classcolor,0,1) eq '#') ?
            $img->colorAllocate(_dehex($classcolor)) :
            $img->colorAllocate(@{$colors{$classcolor}});

    $actcolor = ($actcolor eq 'black') ? $black :
        ($actcolor eq 'white') ? $white :
        (substr($actcolor,0,1) eq '#') ?
            $img->colorAllocate(_dehex($actcolor)) :
            $img->colorAllocate(@{$colors{$actcolor}});
#
#    create arrowhead markers
#
    my ($arrow, $trans, $arrowblack, $poly);

    foreach (@arrowpts) {
        $arrow = GD::Image->new(12,14);
        $trans = $arrow->colorAllocate(128, 128, 128);
        $arrowblack = $arrow->colorAllocate(0,0,0);
        $arrow->transparent($trans);
        $arrow->filledRectangle(0,0,12,14, $trans);
        $poly = GD::Polygon->new();
        $poly->addPt(shift @$_, shift @$_)
            while scalar @$_;
        $arrow->filledPolygon($poly, $arrowblack);
        push @arrows, $arrow;
    }
#
#    load fonts
#    set default to GD fonts
#
    $titlefont = gdGiantFont;
    $classfont = gdGiantFont;
    $methodfont = gdSmallFont;
    $eventfont = gdSmallFont;
    $tinyfont = gdTinyFont;
    my ($boldfont, $italfont);
    if (($^O eq 'MSWin32') &&
        ((!$fontname) || (lc $fontname ne 'gd'))) {
        if ($fontfile) {
            $boldfont = $fontfile;
            $italfont = $fontfile;
        }
        else  {
            $fontname = 'Arial' unless $fontname;

            $fontfile = get_ttf_abs_path($fontname);
            $fontname = 'Arial',
            $fontfile = get_ttf_abs_path($fontname)
                unless $fontfile;

            $boldfont = get_ttf_bold($fontname) || $fontfile;
            $italfont = get_ttf_italic($fontname) || $fontfile;
        }
        $titlefont = $classfont = $boldfont;
        $methodfont = $eventfont = $tinyfont = $fontfile;
    }
    elsif (($^O ne 'MSWin32') && $fontfile) {
# don't really know what to do about non-Win32
#        $boldfont = $fontfile;
#        $italfont = $fontfile;
        $titlefont = $classfont = $boldfont;
        $methodfont = $eventfont = $tinyfont = $fontfile;
    }

    draw_classes($img, $classes, $mapfd, \%priors);
    draw_arrows($img, $doc, $class_hash, $mapfd, \%priors);
    render_text($img, $title);
#
#    DAA terminate areamap
#
    if (defined($mapfd)) {
        print $mapfd '
<script language="JavaScript" type="text/javascript" src="../wz_tooltip.js"></script>

</body>
</html>
'
        if $opts->{j};
        close $mapfd;
    }

    open GDOUT, ">$output_file";
    binmode GDOUT;
    print GDOUT $img->$format();
    close GDOUT unless $output_file eq '-';
}

sub _dehex {
    my $color = substr($_[0], 1);

    my ($len, $off1, $off2) = (length($color) == 6) ? (2, 2, 4) : (2, 4, 8);
    return ((length($color) == 6) || (length($color) == 12)) ?
        (hex(substr($color, 0, $len)),
        hex(substr($color, $len, $len)),
        hex(substr($color, $len << 1, $len))) :
        (0,0,0);
}

sub draw_classes {
  my ($img, $classes, $mapfd, $priors) = @_;

  my $x        = $LEFT_EDGE;
  my $box_left = $x - 8;
  my $max_extent;
  my $boxht = $CLASS_BOX_HEIGHT;
  my $boxtext;

  my $prior = '_EXTERNAL';
  for (my $i = 0; $i < $classes->getLength(); $i++) {
    my $class      = $classes->item($i);
    my $life_x     = int($x + $CLASS_BOX_WIDTH / 2);
    my $class_name = $class  ->getAttribute("name");

    next if ($class_name eq '_EXTERNAL');

    $priors->{$class_name} = $prior;
    $prior = $class_name;
#
#    DAA add hyperlink to psichedocs
#
    my $class_path = ($docpath && ($class_name!~/\s/)) ?
        $docpath . join('/', split(/::/, $class_name)) . '.html' : undef;

    my $born       = $class  ->getAttribute("born")
                     * $ARROW_SPACING + $FIRST_ARROW;
    my $extends_to = ($class ->getAttribute("extends-to") + 1)
                     * $ARROW_SPACING + $FIRST_ARROW;

    if (not defined $max_extent) { $max_extent = $extends_to; }
#
#    DAA rearranged to place text on top of rectangle
#    for fill purposes
#
    $img->setThickness(LINE_THICKNESS);
    $img->filledRectangle($box_left, $CLASS_BOX_Y,
        $box_left + $CLASS_BOX_WIDTH, $CLASS_BOX_Y + $boxht, $classcolor);

    $img->rectangle($box_left, $CLASS_BOX_Y,
        $box_left + $CLASS_BOX_WIDTH, $CLASS_BOX_Y + $boxht, $black);
#
#    draw class name
#
    push @classtext, [$class_hdrs[$i], $x, 26, $CLASS_BOX_WIDTH];
#
#    DAA support areamaps
#
    print $mapfd "<AREA TITLE='$class_name'",
        ($class_path ? " HREF='$class_path'" : ''),
        " SHAPE=RECT COORDS='$box_left,$CLASS_BOX_Y,",
        $box_left + $CLASS_BOX_WIDTH, ',', $CLASS_BOX_Y + $boxht, "'>\n"
        if $mapfd;

    $img->dashedLine($life_x, $born, $life_x, $max_extent, $black);

    my $activation_x = int($box_left + $CLASS_BOX_WIDTH / 2);
    my @activations  = $class->getElementsByTagName("activation");
    foreach my $activation (@activations) {
      $born       = $activation->getAttribute("born");
      $extends_to = $activation->getAttribute("extends-to");
      my $offset     = $activation->getAttribute("offset");
      my $top        = $FIRST_ARROW  + $born       * $ARROW_SPACING;
      my $height     = ($extends_to  - $born + .5) * $ARROW_SPACING;
      my $left       = $activation_x + $offset     * $ACTIVATION_OFFSET;

        $img->filledRectangle($left, $top,
            $left + $ACTIVATION_WIDTH, $top + $height, $actcolor);
        $img->rectangle($left, $top,
            $left + $ACTIVATION_WIDTH, $top + $height, $black);
    }
#    }
    $x        += $CLASS_BOX_WIDTH + $CLASS_SPACING;
    $box_left += $CLASS_BOX_WIDTH + $CLASS_SPACING;
  }
  return $img;
}

sub count_arrows {
  my $doc    = shift;
  my $arrows = $doc->getElementsByTagName("arrow");
  return $arrows->getLength();
}

sub draw_arrows {
  my ($img, $doc, $class_hash, $mapfd, $priors) = @_;

  my $arrows     = $doc->getElementsByTagName("arrow");
  my $annotnum = 1;
  my $annotspan = "\n<ol>\n" if ($annot && ($annot eq 'e'));

  for (my $i = 0; $i < $arrows->getLength(); $i++) {
    my $arrow = $arrows->item($i);
    my $from         = $arrow->getAttribute("from"       );
    my $to           = $arrow->getAttribute("to"         );
#
#    DAA 12/24/2005
#    use type attribute to specify returnvalue or external
#    which changes the line style to dashed or folded, respectively
#    also note that $from for external events originate at the far left
#
    my $type         = $arrow->getAttribute("type"       );
    my $label        = $arrow->getAttribute("label"      );
    my $from_offset  = $arrow->getAttribute("from-offset");
    my $to_offset    = $arrow->getAttribute("to-offset"  );
    my $annots       = $arrow->getElementsByTagName('annotation');
    $annots          = $annots->item(0) if $annots;
    my $y            = $FIRST_ARROW + ($i + 1) * $ARROW_SPACING;

    my $from_number  = ($from eq '_EXTERNAL') ?
        $class_hash->{$priors->{$to}} : $class_hash->{$from};
    my $to_number    = $class_hash->{$to};

    $from_number--, $to_number-- if $ARROW_DELTA;

    $label =~ s/</&lt;/g;
    $label =~ s/>/&gt;/g;
    my $class_path;
#
#    DAA add hyperlink to psichedocs
#
    if ($docpath && ($to!~/\s/)) {
        my $doclabel = $label;
        $doclabel=~s/[\*!]//g;
        $doclabel=~s/^\s*\[[^\]]*\]\s*//;
        $doclabel=~s/^\s+//;
        $doclabel=~s/\s+$//;
        $class_path = $docpath . join('/', split(/::/, $to)) .
            ".html#$doclabel"
            unless ($doclabel=~/\s/);
    }

    if ($from_number < $to_number) {  # arrow from left to right
      my $x1 = $from_number * ($CLASS_BOX_WIDTH + $CLASS_SPACING) + $LEFT_EDGE
               + ($CLASS_BOX_WIDTH + $ACTIVATION_WIDTH)/2
               + $from_offset * $ACTIVATION_OFFSET;
      $x1 += 20 if ($from eq '_EXTERNAL');
      my $x2 = $to_number   * ($CLASS_BOX_WIDTH + $CLASS_SPACING) + $LEFT_EDGE
               + ($CLASS_BOX_WIDTH - $ACTIVATION_WIDTH)/2;
#
#    DAA cuddle the label to the arrowhead
#
      my $xlab = $x2 - $CLASS_SPACING - 6;
      my $ylab = $y  - $charht;
#
#    DAA changed to support call vs. return vs. async activations
#
        $img->setThickness(LINE_THICKNESS);
        ($type eq 'return') ?
            $img->dashedLine($x1, $y, $x2, $y, $black) :
            $img->line($x1, $y, $x2, $y, $black);
        my $arrowimg = $arrows[($type eq 'async') ?
            HALF_RIGHT_ARROW : LEFT_ARROW];
        $img->copy($arrowimg, $x2-14, $y-6, 0,0,
            $arrowimg->width, $arrowimg->height);
#
#    DAA need to add hrefs for methods, but we'll need to track the "to" class
#    name, and ignore names w/ whitespace
#
        drawLabel->($img, $mapfd, $xlab, $ylab, 1,
            $type, $label, $class_path, $mapname, $i,
            \$annotnum, $annots, \$annotspan)
            if defined($label);
    }
    elsif ($from_number > $to_number) {  # arrow from right to left
      my $x1 = $from_number * ($CLASS_BOX_WIDTH + $CLASS_SPACING) + $LEFT_EDGE
               + ($CLASS_BOX_WIDTH - $ACTIVATION_WIDTH)/2;
      my $x2 = $to_number   * ($CLASS_BOX_WIDTH + $CLASS_SPACING) + $LEFT_EDGE
               + ($CLASS_BOX_WIDTH + $ACTIVATION_WIDTH)/2
               + $to_offset * $ACTIVATION_OFFSET;
#
#    DAA changed to support call vs. return vs. async activations
#    (note async activations always go from left to right, so we won't get
#    any here...)
#
        $img->setThickness(LINE_THICKNESS);
        ($type eq 'return') ?
            $img->dashedLine($x1, $y, $x2, $y, $black) :
            $img->line($x1, $y, $x2, $y, $black);
        my $arrowimg = $arrows[RIGHT_ARROW];
        $img->copy($arrowimg, $x2, $y-6, 0,0,
            $arrowimg->width, $arrowimg->height);

      my $xlab = $x2 + $CLASS_SPACING + 6;
      my $ylab = $y  - $charht;
#
#    DAA need to add hrefs for methods, but we'll need to track the "to" class
#    name, and ignore names w/ whitespace
#
        drawLabel->($img, $mapfd, $xlab, $ylab, 0,
            $type, $label, $class_path, $mapname, $i,
            \$annotnum, $annots, \$annotspan)
            if defined($label);
    }
    else {               # arrow from and to same class
      my $x1 = $from_number * ($CLASS_BOX_WIDTH + $CLASS_SPACING) + $LEFT_EDGE
               + ($CLASS_BOX_WIDTH + $ACTIVATION_WIDTH)/2
               + $from_offset * $ACTIVATION_OFFSET;
      my $x2 = $to_number   * ($CLASS_BOX_WIDTH + $CLASS_SPACING) + $LEFT_EDGE
               + ($CLASS_BOX_WIDTH + $ACTIVATION_WIDTH)/2
               + $to_offset * $ACTIVATION_OFFSET;
      $y -= 10;
      my $y2 = $y + 20;
      my $x1padded = $x1 + $ACTIVATION_OFFSET + 15;
        $img->setThickness(LINE_THICKNESS);
        $img->line($x1, $y, $x1padded, $y, $black);
        $img->line($x1padded, $y, $x1padded, $y2, $black);
        $img->line($x1padded, $y2, $x2, $y2, $black);
        my $arrowimg = $arrows[RIGHT_ARROW];
        $img->copy($arrowimg, $x2, $y2-6, 0,0,
            $arrowimg->width, $arrowimg->height);

      my $xlab = $x1padded + $CLASS_SPACING;
      my $ylab = ($y + $y2) / 2;
#
#    DAA need to add hrefs for methods, but we'll need to track the "to" class
#    name, and ignore names w/ whitespace
#
        drawLabel->($img, $mapfd, $xlab, $ylab, 0,
            $type, $label, $class_path, $mapname, $i,
            \$annotnum, $annots, \$annotspan)
            if defined($label);
    }
  }
#
#    DAA save annotations if any
#
    if ($mapfd) {
        print $mapfd "</MAP>\n\n";
        print $mapfd "$annotspan\n</ol>\n"
              if $annotspan && ($annotspan ne '<ol>');
    }

  return $img;
}

sub build_class_name_hash {
    my $class_nodes = shift;
    my %classes;  # keyed by class name store left to right position
    my ($class, $class_name);

    $class = $class_nodes->item($_),
    $class_name = $class->getAttribute('name'),
    $classes{$class_name} = $_
          for (0..$class_nodes->getLength() - 1);

  return \%classes;
}

sub parse_command_line {
    my %opts;
    getopts('a:c:ef:F:g:jm:M:o:p:P:s:w:x:y:', \%opts);
    $output_file = $opts{o} if defined $opts{o};
    $classcolor = $opts{c} || 'white';
    $actcolor = $opts{a} || 'white';
    $docpath = $opts{p} || $opts{P};
    $annot = $opts{e} || $opts{j};
    $fontfile = $opts{F};
    $fontname = $opts{f};
    $sig = $opts{s};
    return \%opts;
}

sub _createLabelMap {
    my ($x1, $y1, $x2, $y2, $title, $name, $path,
        $annot_text, $annot_name, $annot_span) = @_;
#
#    NOTE: Batik seems to render the text coords about 10px lower than raster,
#    so we'll cheat here...may not be needed for GD
#
    $y1 -= 10, $y2 -= 10;
#
#    also, if label has a newline, hyperlink bottom line only
#
    if ($title=~/\n/) {
        $y1 += 16;
        $y2 += 16;
        $x2 = $x1 + ((length($title) - index($title, "\n") - 1) * $charwidth);
    }
    $title=~tr/\n/ /;
    my $maptext =
"<AREA NAME='$name' TITLE='$title' SHAPE=RECT COORDS='$x1,$y1,$x2,$y2' " .
        ($path ? "HREF='$path' " : '');

    if ($annot_text) {
        if ($annot && ($annot eq 'j')) {
#
#    Scripted annotation
#
            $annot_text =~s/'/\\'/g;    # escape single quotes
            $title =~s/'/\\'/g;            # escape single quotes
#
#    NOTE: this must all be on 1 line!!!
#
            $maptext .="
onmouseover=\"this.T_STATIC=true;this.T_FONTCOLOR='black';this.T_FONTSIZE='12px';this.T_BGCOLOR='#e0e0e0';this.T_OPACITY=90;this.T_SHADOWWIDTH=8;return escape('$annot_text')\" >
";
        }
        else {     # annot eq 'e'
#
#    embedded annotation, add anchor and annotation text
#    NOTE: the offsets used here are heuristic, need a bbox jscript
#
            my ($x3, $y3, $y4) = ($x2+4, $y1 + (($y2 - $y1)>>1), $y1 - 4);

            $maptext .= ">
<AREA SHAPE=RECT COORDS='$x2,$y4,$x3,$y3' HREF='#$annot_name'>
";

            $annot_text=~s/</&lt;/g;
            $annot_text=~s/>/&gt;/g;
            $$annot_span .= "
<a name='$annot_name'></a>
<li>$annot_text
<p>
";
        }
    }
    else {
        $maptext .= ">\n";
    }

    return $maptext;
}

sub render_text {
    my $img = shift;
    my $title = shift;
    my ($align, $len, $nl, $oldlen, $ullen, $x, $xul, $y, $yul);

    my $textimg = GD::Text::Wrap->new($img,
        preserve_nl => 1,
        line_space => 0,
        align => 'left',
        color => $black
    );
#
#    render title (if any)
#
    $textimg->set_font($titlefont, 12);
    $textimg->set(text => $title),
    $textimg->draw(5, 15)
        if $title;
#
#    render classnames
#
    $textimg->set_font($classfont, 12);
    foreach (@classtext) {
        $textimg->set(
            text => $_->[0],
            width => $_->[3]);
        $textimg->draw($_->[1], $_->[2]);
    }
#
#    render labels
#
    $img->setThickness(1);
    $textimg->set_font($methodfont, 10);
    foreach (@labeltext) {
#
#    we need to set alignment based on the arrow direction
#
        $align = $_->[5] ? 'right' : 'left';

        $nl = index($_->[0], "\n");
        $x = $xul = $_->[1];
        ($y, $yul) = ($_->[2] - 4, $_->[2] + 10);
        $ullen = $len = $textimg->width($_->[0]);

        if (($nl > 0) && $_->[4]) {
            $yul += $charht + 4,
            my @segs = split(/\n/, $_->[0]);
            $oldlen = $ullen;
            $ullen = $textimg->width($segs[1]);
            $xul += ($oldlen - $ullen)
                if ($align eq 'right') && ($ullen < $oldlen);
        }

        $textimg->set(
            text => $_->[0],
            align => $align,
            width => $len);

        $textimg->draw($x, $y);
        $img->line($xul, $yul, $xul + $ullen, $yul, $black)
            if $_->[4];
    }
#
#    render italics
#
    $textimg->set_font($eventfont, 10);
    foreach (@italtext) {
        $len = $textimg->width($_->[0]);
        $textimg->set(
            text => $_->[0],
            width => $len);
        $textimg->draw($_->[1], $_->[2] - 4);
        $img->line($_->[1], $_->[2] + 10, $_->[1] + $len, $_->[2] + 10, $black)
            if $_->[4];
    }
#
#    render superscripts
#
    $textimg->set_font($tinyfont, 8);
    $textimg->set(
        text => $_->[0],
        align => 'left',
        width => 10),
    $textimg->draw($_->[1], $_->[2])
        foreach (@supertext);
#
#    render signature (if any)
#
    if ($sig) {
        $textimg->set_font($tinyfont, 6);
        $len = $textimg->width($sig);
        $textimg->set(
            text => $sig,
            width => $len,
            align => 'left');
        my ($x, $y) = ($img->width - $len - 20, $img->height - 20);
        $textimg->draw($x, $y)
    }

    return 1;
}

sub drawLabel {
    my ($img, $mapfd, $xlab, $ylab, $align, $type, $label, $path,
        $mapname, $i, $annotnum, $annots, $annotspan) = @_;

     $xlab -= ($charwidth * length($label)) if $align;
    my $xend = $xlab + ($charwidth * length($label));
    my $yend = $ylab + $charht;
    my $xmap = $xlab;

    if ($type eq 'async') {
        push @italtext,
            [ $label, $xlab, $ylab, $xend - $xlab - 6,
                (($annot && ($annot eq 'j') && $annots) ? 1 : undef), $align ];
    }
    else {
#
#    if conditional, add line break
#
        if ($label=~s/^(\[[^\]]+\])\s*(.*)$/$1\n$2/) {
#
#    and adjust offsets
#
            my ($top, $bot) = (length($1), length($2));
            $top = $bot if ($top < $bot);
            $xlab = $xend - ($top * $charwidth),
            $xmap = $xend - ($bot * $charwidth)
                if $align;
            $ylab -= ($charht + 6);
        }
        push @labeltext,
            [ $label, $xlab, $ylab, $xend - $xlab - 6,
                (($annot && ($annot eq 'j') && $annots) ? 1 : undef), $align ];
    }
#
#    if annotated, add superscript if embedded
#
    push @supertext, [ $$annotnum++, $xend, $ylab - 5 ]
        if ($annot && ($annot eq 'e') && $annots);
#
#    DAA support areamaps
#
    $ylab += $charht,
    $yend += $charht
        unless ($yend - $ylab > $charht);
    print $mapfd _createLabelMap(
        $xmap, $ylab, $xend, $yend,             # location
        $label, "$mapname\_$i", (($type eq 'call') ? $path : undef),
        ($annots ? $annots->getAttribute('text') : undef),
            "$mapname\_annot_$i", $annotspan)    # annotation
        if $mapfd;

    return $img;
}
#
#    to wrap long class names in the header boxes
#
sub _wrapText {
    my ($text, $xpos) = @_;

    return $text
        if ((length($text) * $classcharwidth) < ($CLASS_BOX_WIDTH - 6));
#
#    split on whitespace, dot/colon/underscore, or
#    lowercaseUppercase
#
    my $maxChars = int(($CLASS_BOX_WIDTH - 10)/$classcharwidth);
    my @lines = ();
    my @pieces = ();
    while ($text=~s/([^:\.\s_]+)((:+)|\.|_|\s+)?//) {
        my ($t, $p) = ($1, $2);
        push @pieces, $t;
#
#    if the text is still too long, look for lowerUpper
#
        if (length($pieces[-1]) <= $maxChars) {
            push(@pieces, $p) if $p;
            next;
        }

        $t = pop @pieces;
        push @pieces, $1
            while ($t=~s/^(.*?[a-z])([A-Z].*)$/$2/);
        push @pieces, $t if ($t ne '');

        push(@pieces, $p) if $p;
    }
#
#    now reassemble to minimize box height
#
    $lines[0] = shift @pieces;
    foreach (@pieces) {
        $lines[-1] .= $_,
        next
            if (length($lines[-1]) <= $maxChars) &&
                ((length($lines[-1]) + length($_)) <= $maxChars);
        push @lines, $_ unless /^\s+$/;
    }

    return join("\n", @lines);
}
1;