| OLD | NEW |
| (Empty) |
| 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 | |
| OLD | NEW |