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 |