1 #! /usr/bin/perl -w 2 3 # Takes a set of ps images (belonging to one file) and produces a 4 # conglomerate picture of that file: static functions in the middle, 5 # others around it. Each one gets a box about its area. 6 7 use strict; 8 9 my $SCRUNCH = $ARGV [0]; 10 my $BOXSCRUNCH = $ARGV [1]; 11 my $Tmp; 12 my $DEBUG = 1; 13 14 shift @ARGV; # skip SCRUNCH and BOXSCRUNCH 15 shift @ARGV; 16 17 18 DecorateFuncs (@ARGV); 19 20 21 #TMPFILE=`mktemp ${TMPDIR:-/tmp}/$$.XXXXXX` 22 23 # Arrange. 24 my $ArgList = ""; 25 26 foreach $Tmp (@ARGV) { 27 $ArgList .= "'$Tmp' "; 28 } 29 30 my @Arranged = `../draw_arrangement $SCRUNCH 0 360 0 $ArgList`; 31 32 my $CFile = $ARGV [0]; 33 $CFile =~ s/\.c\..*$/.c/; 34 if ($DEBUG) { print ("% Conglomeration of $CFile\n"); } 35 36 print "gsave angle rotate\n"; 37 38 # Now output the file, except last line. 39 my $LastLine = pop (@Arranged); 40 my $Fill = Box_2 ($LastLine,$CFile); 41 print $Fill; 42 # Draw box with file name 43 my @Output = Box ('normal', 'Helvetica-Bold', 32, $CFile, $LastLine); 44 splice(@Output, $#Output, 0, "grestore\n"); 45 #print @Output; 46 47 print (@Arranged); 48 #add a duplicate box to test if this works 49 print @Output; 50 51 52 sub ParseBound 53 { 54 my $BBoxLine = shift; 55 56 $BBoxLine =~ /(-?[\d.]+)\s+(-?[\d.]+)\s+(-?[\d.]+)\s+(-?[\d.]+)/; 57 58 # XMin, YMin, XMax, YMax 59 return ($1 * $BOXSCRUNCH, $2 * $BOXSCRUNCH, 60 $3 * $BOXSCRUNCH, $4 * $BOXSCRUNCH); 61 } 62 63 64 65 # Box (type, font, fontsize, Label, BBoxLine) 66 sub Box 67 { 68 my $Type = shift; 69 my $Font = shift; 70 my $Fontsize = shift; 71 my $Label = shift; 72 my $BBoxLine = shift; 73 my @Output = (); 74 75 # print (STDERR "Box ('$Type', '$Font', '$Fontsize', '$Label', '$BBoxLine')\n"); 76 push (@Output, "% start of box\n"); 77 78 push (@Output, "D5\n") if ($Type eq "dashed"); 79 80 # print (STDERR "BBoxLine: '$BBoxLine'\n"); 81 # print (STDERR "Parsed: '" . join ("' '", ParseBound ($BBoxLine)) . "\n"); 82 my ($XMin, $YMin, $XMax, $YMax) = ParseBound ($BBoxLine); 83 84 my $LeftSpaced = $XMin + 6; 85 my $BottomSpaced = $YMin + 6; 86 87 # Put black box around it 88 push (@Output, ( 89 "($Label) $LeftSpaced $BottomSpaced $Fontsize /$Font\n", 90 "$YMin $XMin $YMax $XMax U\n" 91 ) 92 ); 93 94 push (@Output, "D\n") if ($Type eq "dashed"); 95 # fill bounding box 96 push (@Output, "% end of box\n"); 97 98 # Output bounding box 99 push (@Output, "% bound $XMin $YMin $XMax $YMax\n"); 100 101 return @Output; 102 } 103 104 sub Box_2 105 { 106 my $BBoxLine = shift; 107 my $CFile = shift; 108 my $CovFile = "./coverage.dat"; 109 my ($XMin, $YMin, $XMax, $YMax) = ParseBound ($BBoxLine); 110 my @output = `fgrep $CFile $CovFile`; 111 chomp $output[0]; 112 my ($junk, $Class, $per) = split /\t/, $output[0]; 113 return "$XMin $YMin $XMax $YMax $Class\n"; 114 } 115 # Decorate (rgb-vals(1 string) filename) 116 sub Decorate 117 { 118 my $RGB = shift; 119 my $Filename = shift; 120 121 my @Input = ReadPS ($Filename); 122 my $LastLine = pop (@Input); 123 my @Output = (); 124 125 # Color at the beginning. 126 push (@Output, "C$RGB\n"); 127 128 # Now output the file, except last line. 129 push (@Output, @Input); 130 131 # Draw dashed box with function name 132 # FIXME Make bound cover the label as well! 133 my $FuncName = $Filename; 134 $FuncName =~ s/^[^.]+\.c\.(.+?)\..*$/$1/; 135 136 push (@Output, Box ('dashed', 'Helvetica', 24, $FuncName, $LastLine)); 137 138 # Slap over the top. 139 WritePS ($Filename, @Output); 140 } 141 142 143 144 # Add colored boxes around functions 145 sub DecorateFuncs 146 { 147 my $FName = ""; 148 my $FType = ""; 149 150 foreach $FName (@ARGV) 151 { 152 $FName =~ /\+([A-Z]+)\+/; 153 $FType = $1; 154 155 if ($FType eq 'STATIC') { 156 Decorate ("2", $FName); # Light green. 157 } 158 elsif ($FType eq 'INDIRECT') { 159 Decorate ("3", $FName); # Green. 160 } 161 elsif ($FType eq 'EXPORTED') { 162 Decorate ("4", $FName); # Red. 163 } 164 elsif ($FType eq 'NORMAL') { 165 Decorate ("5", $FName); # Blue. 166 } 167 else { 168 die ("Unknown extension $FName"); 169 } 170 } 171 } 172 173 174 sub ReadPS 175 { 176 my $Filename = shift; 177 my @Contents = (); 178 179 open (INFILE, "$Filename") or die ("Could not read $Filename: $!"); 180 @Contents = <INFILE>; 181 close (INFILE); 182 183 return @Contents; 184 } 185 186 sub WritePS 187 { 188 my $Filename = shift; 189 190 open (OUTFILE, ">$Filename") 191 or die ("Could not write $Filename: $!"); 192 print (OUTFILE @_); 193 close (OUTFILE); 194 } 195 196
