|
1 # Copyright (c) 1999-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
2 # All rights reserved. |
|
3 # This component and the accompanying materials are made available |
|
4 # under the terms of "Eclipse Public License v1.0" |
|
5 # which accompanies this distribution, and is available |
|
6 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
7 # |
|
8 # Initial Contributors: |
|
9 # Nokia Corporation - initial contribution. |
|
10 # |
|
11 # Contributors: |
|
12 # |
|
13 # Description: |
|
14 # |
|
15 |
|
16 use strict; |
|
17 |
|
18 # |
|
19 # constants |
|
20 # |
|
21 my $incrementY = 20; |
|
22 my $leftMargin = 60; |
|
23 my $rightMargin = 150; |
|
24 my $topMargin = 20; |
|
25 my $topOffset = $topMargin; # is this right Nadeem? |
|
26 my $objectSpacing = 110; |
|
27 my $arrowWidth = 10; |
|
28 my $textArrowSpacing = 1; |
|
29 my $messageSpacingAboveLine = 1; |
|
30 my $objectVerticalLineSpacing = 2; |
|
31 my $objectUnderlineToLifelineGap = 2; |
|
32 |
|
33 my $objectName = 0; |
|
34 my $objectX = 1; |
|
35 my $objectY = 2; |
|
36 my $objectMsgCount = 3; |
|
37 my $objectCreationPointKnown = 4; |
|
38 |
|
39 my $sequenceAction = 0; |
|
40 my $sequenceObjRef = 1; # if action == "t" || "oc" |
|
41 my $sequenceMsgRef = 1; # if action != "t" |
|
42 my $sequenceX = 2; |
|
43 my $sequenceY = 3; |
|
44 |
|
45 my $trimSilentFlag = 0; |
|
46 my $objectsDisplayedAtCreationPoint = 1; |
|
47 # |
|
48 # global variables |
|
49 # |
|
50 my $currentY = $topMargin; |
|
51 |
|
52 my @sequences = (); |
|
53 my @objects = (); |
|
54 my @messages = (); |
|
55 |
|
56 |
|
57 |
|
58 # |
|
59 # Data Structures: |
|
60 # |
|
61 # "objects" is array of arrays: |
|
62 # [ <object name> <object X> <object Y> <object message count> <creation point known flag> ] |
|
63 # |
|
64 # "sequences" is an array of arrays: |
|
65 # [ "t" \objects[<n>] "text" ] |
|
66 # [ "[p|r]" \messages[n] \objects[<source>], \objects[<destination>] ] |
|
67 # [ "oc" \objects[<n>] ] |
|
68 |
|
69 |
|
70 # Input file format: |
|
71 # |
|
72 # <action> <arguments> ... |
|
73 # |
|
74 # specifically: |
|
75 # |
|
76 # [P|R] <message name> <source object> <destination object> |
|
77 # T <object> <text> |
|
78 # OC <object> |
|
79 # |
|
80 # actions: |
|
81 # |
|
82 # P Post |
|
83 # R Receive |
|
84 # T Text |
|
85 # OC Object Create |
|
86 # |
|
87 # All fields are space separated text. For example: |
|
88 # |
|
89 # P StartFlow SCPR Flow |
|
90 # |
|
91 |
|
92 while (<>) { |
|
93 die unless s/^(\w+)\s+//; |
|
94 my $action = $1; |
|
95 if ($action eq "t") |
|
96 { |
|
97 # Text |
|
98 # t <object> <text> |
|
99 my $pos; |
|
100 if (s/^(\w+)\s+//) { $pos = $1; } |
|
101 my $objRef = addObject($pos); |
|
102 chomp; |
|
103 my $text = $_; |
|
104 push @sequences, [$action, $objRef, $text]; |
|
105 } |
|
106 elsif ($action eq "oc") |
|
107 { |
|
108 # Object Create |
|
109 # oc <object> |
|
110 my $objName; |
|
111 if (s/^(\w+)\s+//) { $objName = $1; } |
|
112 my $objRef = addObject($objName); |
|
113 ${$objRef}->[$objectCreationPointKnown] = 1; |
|
114 chomp; |
|
115 push @sequences, [$action, $objRef]; |
|
116 } |
|
117 else |
|
118 { |
|
119 # Post/Receive |
|
120 # [P|R] <message> <source object> <destination object> |
|
121 split; |
|
122 my $msgRef = addMessage(shift @_); |
|
123 my $srcRef = addObject(shift @_); |
|
124 my $destRef = addObject(shift @_); |
|
125 ${$srcRef}->[$objectMsgCount]++; |
|
126 ${$destRef}->[$objectMsgCount]++; |
|
127 push @sequences, [$action, $msgRef, $srcRef, $destRef]; |
|
128 } |
|
129 } |
|
130 |
|
131 if ($trimSilentFlag) |
|
132 { |
|
133 trimSilentObjects(); |
|
134 } |
|
135 calculateObjectRowPositions(); |
|
136 |
|
137 my $screenWidth = $objects[$#objects]->[$objectX] + $rightMargin; |
|
138 my $screenHeight = scalar(@sequences) * ($incrementY + 2) + $topMargin; |
|
139 |
|
140 |
|
141 outputDocHeader($screenWidth, $screenHeight); |
|
142 |
|
143 drawObjectsAtTop(); |
|
144 |
|
145 drawObjectsRepeatedly(); |
|
146 |
|
147 drawSequences(); |
|
148 |
|
149 outputDocFooter(); |
|
150 |
|
151 #################### |
|
152 # Message routines |
|
153 #################### |
|
154 |
|
155 sub addMessage() |
|
156 { |
|
157 my $obj = $_[0]; |
|
158 my $i; |
|
159 for ($i = 0 ; $i < scalar(@messages) ; ++$i) { |
|
160 if ($messages[$i] eq $obj) { |
|
161 return \$messages[$i]; |
|
162 } |
|
163 } |
|
164 $messages[$i] = $obj; |
|
165 return \$messages[$i]; |
|
166 } |
|
167 |
|
168 sub printMessages() |
|
169 { |
|
170 print "Messages (", scalar(@messages), ") : "; |
|
171 foreach my $msg (@messages) { |
|
172 print $msg, " "; |
|
173 } |
|
174 print "\n"; |
|
175 } |
|
176 |
|
177 ################### |
|
178 # Object routines |
|
179 ################### |
|
180 |
|
181 sub addObject() |
|
182 { |
|
183 my $objName = $_[0]; |
|
184 my $i; |
|
185 for ($i = 0 ; $i < scalar(@objects) ; ++$i) { |
|
186 if ($objects[$i]->[$objectName] eq $objName) { |
|
187 return \$objects[$i]; |
|
188 } |
|
189 } |
|
190 $objects[$i] = [ $objName, 0, 0, 0, 0 ]; |
|
191 return \$objects[$i]; |
|
192 } |
|
193 |
|
194 sub printObjects() |
|
195 { |
|
196 print "Objects (", scalar(@objects), "): "; |
|
197 foreach my $obj (@objects) { |
|
198 print $obj->[0], "(", $obj->[1], ") "; |
|
199 } |
|
200 print "\n"; |
|
201 } |
|
202 |
|
203 sub calculateObjectRowPositions() |
|
204 { |
|
205 # first object position is at left margin |
|
206 $objects[0][$objectX] = $leftMargin; |
|
207 my $i; |
|
208 for ($i = 1 ; $i < scalar(@objects) ; ++$i) { |
|
209 $objects[$i][$objectX] = $objects[$i-1][$objectX] + $objectSpacing; |
|
210 } |
|
211 } |
|
212 |
|
213 sub trimSilentObjects() |
|
214 { |
|
215 # get rid of objects that didn't end up with any messages sent to/from them |
|
216 my $i; |
|
217 for ($i = 0 ; $i < scalar(@objects) ; ) { |
|
218 if ($objects[$i][$objectMsgCount] == 0) |
|
219 { |
|
220 my $j; |
|
221 for ($j = 0 ; $j < scalar(@sequences) ; ) |
|
222 { |
|
223 my $action = $sequences[$j][$sequenceAction]; |
|
224 if ( (($action eq "t") || ($action eq "oc")) && |
|
225 ($sequences[$j][$sequenceObjRef] == \$objects[$i]) ) |
|
226 { |
|
227 splice @sequences, $j, 1; |
|
228 #print "delete sequence $j\n"; |
|
229 #++$j; |
|
230 } |
|
231 else |
|
232 { |
|
233 ++$j; |
|
234 } |
|
235 } |
|
236 splice @objects, $i, 1; |
|
237 #print "delete object $i $objects[$i][$objectName]\n"; |
|
238 #++$i; |
|
239 } |
|
240 else |
|
241 { |
|
242 ++$i; |
|
243 } |
|
244 } |
|
245 } |
|
246 |
|
247 sub drawObject($$$) |
|
248 { |
|
249 my ($x,$y,$name) = @_; |
|
250 outputText($x, $name, $y, "middle", "underline"); |
|
251 outputVerticalLine($x, $y + $objectUnderlineToLifelineGap, $screenHeight - $topOffset); |
|
252 } |
|
253 |
|
254 sub drawObjectsAtTop() |
|
255 { |
|
256 my $i; |
|
257 foreach $i (@objects) { |
|
258 if ($objectsDisplayedAtCreationPoint == 1 && $i->[$objectCreationPointKnown] == 1) |
|
259 { |
|
260 next; |
|
261 } |
|
262 outputText($i->[$objectX], $i->[$objectName], $currentY, "middle", "underline"); |
|
263 } |
|
264 incrementY(); |
|
265 drawObjectLifelines(); |
|
266 } |
|
267 |
|
268 sub drawObjectsRepeatedly() |
|
269 { |
|
270 my $i; |
|
271 foreach $i (@objects) |
|
272 { |
|
273 for( my $j = 400 ; $j < $screenHeight ; $j += 400 ) |
|
274 { |
|
275 outputText($i->[$objectX], $i->[$objectName], $j, "middle", "","silver"); |
|
276 } |
|
277 } |
|
278 } |
|
279 |
|
280 sub drawSequences() |
|
281 { |
|
282 foreach my $ref (@sequences) { |
|
283 my $action = $ref->[$sequenceAction]; |
|
284 if ($action eq "t") |
|
285 { |
|
286 my $objX = ${$ref->[$sequenceObjRef]}->[$objectX]; |
|
287 my $text = $ref->[2]; |
|
288 outputText($objX, $text, $currentY, "middle"); |
|
289 incrementY(); |
|
290 } |
|
291 elsif ($action eq "oc") |
|
292 { |
|
293 if ($objectsDisplayedAtCreationPoint == 1) |
|
294 { |
|
295 my $objX = ${$ref->[$sequenceObjRef]}->[$objectX]; |
|
296 my $objName = ${$ref->[$sequenceObjRef]}->[$objectName]; |
|
297 drawObject($objX, $currentY, $objName); |
|
298 incrementY(); |
|
299 } |
|
300 } |
|
301 else |
|
302 { |
|
303 my $msg = ${$ref->[$sequenceObjRef]}; |
|
304 my $srcX = ${$ref->[$sequenceX]}->[$objectX]; |
|
305 my $destX = ${$ref->[$sequenceY]}->[$objectX]; |
|
306 my $align; |
|
307 if ($action eq "p") { |
|
308 $align = "tail"; |
|
309 } |
|
310 elsif ($action eq "r") { |
|
311 $align = "head"; |
|
312 } |
|
313 outputLabelledLine($srcX, $destX, $msg, $align); |
|
314 incrementY(); |
|
315 } |
|
316 } |
|
317 } |
|
318 |
|
319 sub drawObjectLifelines() |
|
320 { |
|
321 my $topOffset = $topMargin + $objectVerticalLineSpacing; |
|
322 foreach my $i (@objects) { |
|
323 if ($objectsDisplayedAtCreationPoint == 0 || $i->[$objectCreationPointKnown] == 0) |
|
324 { |
|
325 outputVerticalLine($i->[$objectX], $topOffset, $screenHeight - $topOffset); |
|
326 } |
|
327 } |
|
328 } |
|
329 |
|
330 ####################### |
|
331 # SVG output routines |
|
332 ####################### |
|
333 |
|
334 sub outputDocHeader() |
|
335 { |
|
336 my ($width,$height) = @_; |
|
337 print '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>',"\n"; |
|
338 print '<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">',"\n"; |
|
339 print "<svg height=\"$height\" width=\"$width\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\">\n"; |
|
340 outputDefs(); |
|
341 } |
|
342 |
|
343 sub outputDefs() |
|
344 { |
|
345 print "<defs>\n"; |
|
346 print qq{<marker id="arr" markerHeight="10" markerUnits="strokeWidth" markerWidth="10" orient="auto" refX="10" refY="5" viewBox="0 0 10 10">\n}; |
|
347 print qq{\t<path d="M 0 0 L 10 5 L 0 10 " />\n}; |
|
348 print "</marker>\n"; |
|
349 print "</defs>\n"; |
|
350 } |
|
351 |
|
352 sub outputDocFooter() |
|
353 { |
|
354 print "</svg>\n"; |
|
355 } |
|
356 |
|
357 sub outputLabelledLine() |
|
358 { |
|
359 my ($x1,$x2,$text,$alignment) = @_; |
|
360 outputLine($x1,$x2); |
|
361 my $textx; |
|
362 my $anchor; |
|
363 my $colour = 'grey'; |
|
364 if (!$alignment || $alignment eq "mid") { |
|
365 $textx = (($x1 + $x2) / 2); |
|
366 $anchor = "middle"; |
|
367 } |
|
368 else { |
|
369 if ($alignment eq "head") { |
|
370 $colour='red'; |
|
371 if ($x1 < $x2) { |
|
372 $anchor = "end"; |
|
373 $textx = $x2 - $arrowWidth - $textArrowSpacing; |
|
374 } |
|
375 else { |
|
376 $anchor = "start"; |
|
377 $textx = $x2 + $arrowWidth + $textArrowSpacing; |
|
378 } |
|
379 } else { # "tail" |
|
380 $colour='green'; |
|
381 $textx = $x1; |
|
382 if ($x1 < $x2) { |
|
383 $anchor = "start"; |
|
384 } else { |
|
385 $anchor = "end"; |
|
386 } |
|
387 } |
|
388 } |
|
389 |
|
390 outputText($textx,$text,$currentY - $messageSpacingAboveLine, $anchor,'',$colour); |
|
391 } |
|
392 |
|
393 sub outputText() |
|
394 { |
|
395 my ($x,$text,$y,$anchor,$decoration,$colour) = @_; |
|
396 |
|
397 my $attrs = qq{ x="$x" y="$y" }; |
|
398 |
|
399 if ($decoration) |
|
400 { |
|
401 $attrs .= qq{ text-decoration="$decoration" }; |
|
402 } |
|
403 |
|
404 if ($colour) |
|
405 { |
|
406 $attrs .= qq{ stroke="$colour" }; |
|
407 } |
|
408 |
|
409 if ($anchor) |
|
410 { |
|
411 $attrs .= qq { text-anchor="$anchor" }; |
|
412 } |
|
413 |
|
414 print "<text $attrs>$text</text>\n"; |
|
415 } |
|
416 |
|
417 sub outputLine() |
|
418 { |
|
419 my ($x1,$x2) = @_; |
|
420 print qq{<line stroke="black" marker-end="url(#arr)" x1="$x1" y1="$currentY" x2="$x2" y2="$currentY" />\n}; |
|
421 } |
|
422 |
|
423 sub outputVerticalLine() |
|
424 { |
|
425 my ($x,$y1,$y2) = @_; |
|
426 print qq{<line stroke="black" x1="$x" y1="$y1" x2="$x" y2="$y2" />\n}; |
|
427 } |
|
428 |
|
429 sub incrementY() |
|
430 { |
|
431 my $amount; |
|
432 if ($_[0]) { |
|
433 $amount = $_[0]; |
|
434 } else { |
|
435 $amount = 1; |
|
436 } |
|
437 $currentY += $incrementY * $amount; |
|
438 } |