perl GD 使用例子一则

#parent,1,3,561,224,374,KernelSpace,
#parent,4,3,3,223,275,LMGT,
#child,4,5,50,10,100,25,Task Initial,
#child,4,6,10,197,195,25,10) Connection kconKernel,
#child,1,7,10,595,195,25,35) Connection kconLog,
#parent,13,3,303,223,229,AMGT,
#child,13,14,50,310,100,25,Task Initial,
#child,13,15,10,345,195,25,10) Connection kconLog,
#child,4,16,10,240,195,25,11) Connection kconAMGT,
#child,1,17,10,628,195,25,34) Task ktskVirtualCAN,
#parent,35,351,226,220,258,CANOPEN,
#child,35,36,420,233,100,25,Task Initial,
#child,4,37,10,156,195,25,12) Connection kconCANOPEN,
#child,35,38,360,266,195,25,10) Connection kconLog,
#child,13,39,10,387,195,25,11) Link klnkTskCANOPEN,
#child,1,55,10,663,195,25,36) Link klnkTskAMGT,
#child,1,71,10,753,157,25,37) IODevice EtherDev,
#child,1,72,10,786,157,25,38) IODevice CAN0,
#child,1,108,10,821,157,25,39) IODevice CAN1,
#child,1,109,10,856,157,25,40) IODevice CAN2,
#child,1,110,10,891,157,25,41) IODevice CAN3,
##
#link,1,7,6,259,607,259,209,
#link,2,16,15,242,252,242,357,
#link,8,37,38,296,168,296,278,
#link,11,55,14,303,675,303,322,
#link,14,39,36,330,399,330,132,470,132,
##

# Summary: Visualize integrate position file to png file
# Author: mzhicheng <mzhicheng AT ********** DOT com>
# CVS ID: $Id: inp2png.pl,v 1.1 2008/10/18 00:57:42 mzhicheng Exp $
# Revision: $Revision: 1.1 $

use strict;
use warnings;

use GD::Simple;

die unless @ARGV == 2;
my ($inpfile, $outputfile) = @ARGV;

my $margin = 24;
my $fontsize = 10;
my $fontmargin = 5;
my (%objects, %links);
my ($outwidth, $outheight) = (800, 600);
my ($xmax, $ymax) = (0,0);

# parse inp file
open INP, '<', $inpfile
 or die "Can not open inp file $outputfile: $!";
while (<INP>) {
 chomp;
 my $line = $_;
 my ($type, @args) = split /,/, $line;
 if ($type eq '#parent') {
 my ($id, $x, $y, $width, $height, $name) = @args;
 $objects{$id} = {
 parent => undef,
 x => $x + $margin/2,
 y => $y + $margin/2,
 width => $width,
 height => $height,
 name => $name
 };
 $xmax = $x + $width if $x + $width > $xmax;
 $ymax = $y + $height if $y + $height > $ymax;
 } elsif ($type eq '#child') {
 my ($pid, $id, $x, $y, $width, $height, $name) = @args;
 $objects{$id} = {
 parent => $pid,
 x => $x + $margin/2,
 y => $y + $margin/2,
 width => $width,
 height => $height,
 name => $name
 };
 } elsif ($type eq '#link') {
 my ($id, $from, $to, @path) = @args;
 $links{$id} = {
 from => $from,
 to => $to,
 path => [map [map {$_ + $margin/2} splice @path, 0, 2], 1..(@path/2)]
 };
 } elsif ($type eq '##') {
 } else {
 die "Invalid inp file, invalid line: $line\n";
 }
}
close INP;

# create png file
my $img = GD::Simple->new($xmax + $margin, $ymax + $margin);
$img->font('Times');
sub drawbox {
 my ($img, $object) = @_;

$img->rectangle($object->{x}, $object->{y},
 $object->{x} + $object->{width},
 $object->{y} + $object->{height});
 $img->moveTo($object->{x} + $fontmargin,
 $object->{y} + $fontsize + $fontmargin);
 $img->fontsize($fontsize);
 $img->string($object->{name});

}
## parents boxes
for my $object (grep {!defined $_->{parent}} values %objects) {
 # set corresponding color
 if ($object->{name} eq 'KernelSpace') {
 $img->bgcolor('LightYellow');
 } else {
 $img->bgcolor('LightSkyBlue');
 }

drawbox($img, $object);
}
## links
for my $link (values %links) {
 my $fromobj = $objects{$link->{from}};
 my $toobj = $objects{$link->{to}};
 my $beginx = $fromobj->{x} + $fromobj->{width}/2;
 my $beginy = $fromobj->{y} + $fromobj->{height}/2;
 my $endx = $toobj->{x} + $toobj->{width}/2;
 my $endy = $toobj->{y} + $toobj->{height}/2;
 $img->moveTo($beginx, $beginy);
 for my $path (@{$link->{path}}, [$endx, $endy]) {
 $img->lineTo($path->[0], $path->[1]);
 }
}
## children boxes
for my $object (grep {defined $_->{parent}} values %objects) {
 # set corresponding color
 if ($object->{name} =~ m/Connection/) {
 $img->bgcolor('Orange');
 } elsif ($object->{name} =~ m/Task/) {
 $img->bgcolor('Blue');
 } elsif ($object->{name} =~ m/Link/) {
 $img->bgcolor('Pink');
 } elsif ($object->{name} =~ m/IODevice/) {
 $img->bgcolor('Orchid');
 } else {
 $img->bgcolor('Gray');
 }

drawbox($img, $object);
}

# output png file
open OUTPUT, '>', $outputfile
 or die "Can not open file $outputfile to output: $!";
print OUTPUT $img->png;
close OUTPUT;