|
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 require 'getopts.pl'; |
|
17 use strict; |
|
18 my $version = "2.1 (28/11/07)"; |
|
19 my $animate = 1; |
|
20 my $debug; |
|
21 my $maxRelationsPopupHeight = 980; # maximum height of relations popup window |
|
22 # |
|
23 # Notes for future merging with parseseq.pl: |
|
24 # - usage of %symtab with "oc" and "od" |
|
25 |
|
26 # |
|
27 # Abstract principles: |
|
28 # |
|
29 # Objects are conceptually placed within a variable sized rectangular "super" grid. Each position of this |
|
30 # grid represents a particular "type" of object (e.g. IP SubConnection Provider). More than one object |
|
31 # (of the same type) can occupy the same position on this grid. Consequently, each grid position has |
|
32 # within it a variable sized rectangular "sub-grid" that is used to define the placement of each of the |
|
33 # individual objects that occupy the same super grid position. The object placement within the sub-grid |
|
34 # is calculated to avoid connecting lines to neighbouring objects from passing through other objects |
|
35 # (this is, in fact, the raison d'etre for the sub-grid concept). Note that the sub-grid can have |
|
36 # larger dimensions than the number of objects within it - i.e. it can have "empty" spaces. This |
|
37 # is a consequence of the simple placement algorithm: |
|
38 # |
|
39 # Each sub-grid in the super grid has a (subRow,subCol) variable that starts with the value (0,0). The |
|
40 # first object is placed at (0,0). For every subsequent object needs to be placed, if there are has |
|
41 # any horizontal connections ("west" or "east") to neighbouring objects, then (subRow) variable is |
|
42 # incremented. if there are any vertical connections, then (subCol) variable is incremented. The object |
|
43 # is then placed at the final (subRow,subCol) position within the sub-grid, and process repeats. |
|
44 # |
|
45 # Each set of inter-related objects forms a "group". The relationship is based around the exchange of |
|
46 # messages. There may be several such distinct and seperate groups. By definition, no object in one |
|
47 # group has any message exchange with an object in another group. |
|
48 # |
|
49 # Example of two groups: |
|
50 # |
|
51 # group 1: |
|
52 # |
|
53 # A -- B -- C |
|
54 # | |
|
55 # D |
|
56 # |
|
57 # group 2: |
|
58 # |
|
59 # E -- F -- G |
|
60 # | |
|
61 # H |
|
62 # |
|
63 # Two groups are merged into one if, whilst reading the message sequence file, a message is found to flow from |
|
64 # an object in one group is sent to an object in another group. For example, if object D sends a message to |
|
65 # object E, then a larger group is formed: |
|
66 # |
|
67 # |
|
68 # group 1: |
|
69 # |
|
70 # A -- B -- C |
|
71 # | |
|
72 # D |
|
73 # | |
|
74 # E -- F -- G |
|
75 # | |
|
76 # H |
|
77 |
|
78 |
|
79 |
|
80 # |
|
81 # Each object is a hash: |
|
82 # n => array of object references to objects that are "north" of this object |
|
83 # s => array of object references to objects that are "south" of this object |
|
84 # w => array of object references to objects that are "west" of this object |
|
85 # e => array of object references to objects that are "east" of this object |
|
86 # group => group number. Each group is a set of interconnected objects. |
|
87 # col => column number of object within super grid |
|
88 # row => row number of object within super grid |
|
89 # subCol => column number of object within sub-grid (within supergrid col,row position) |
|
90 # subRow => row number of objects within sub-grid (within supergrid col,row position) |
|
91 # |
|
92 # subGridPlacement[<col>][<row>] is a hash containing the (subRow,subCol) variable pair for a sub-grid at |
|
93 # a particular <col> and <row> in the overall grid: |
|
94 # subCol => <subCol> |
|
95 # subRow => <subRow> |
|
96 # |
|
97 # colToSubColIndex[<col>] and rowToSubRowIndex[<row>] are arrays containing the cumulative total number of sub-grid |
|
98 # columns and rows, respectively, at a particular <col> and <row> position in the super grid. |
|
99 # For example, if the first, second and third columns of the super grid contain sub-grids of |
|
100 # 2, 1 and 3 columns respectively, then colToSubColIndex[] contains 0, 2, 3, 6, ...). |
|
101 # |
|
102 # colToSubGridWidth[<col>] and rowToSubGridHeight[<row>] are arrays containing the width and height respectively |
|
103 # of the sub-grid at a particular <col> and <row> position in the super grid, respectively. |
|
104 # |
|
105 # gridVerticalLineCount[<col>] and gridHorizontalLineCount[<row>] are arrays containing the number |
|
106 # of "long" lines that run vertically and horizontally at certain <col> and <row> positions in the |
|
107 # grid for connecting objects that are not neighbours. Objects connected to immediate neighbours |
|
108 # do not have "long" lines and are not counted here. |
|
109 # |
|
110 # groupRanges{<group>} is a hash which contains |
|
111 # minCol => minimum column number of any object within the group |
|
112 # maxCol => maximum column number of any object within the group |
|
113 # minRow => minimum row number of any object within the group |
|
114 # maxRow => maximum row number of any object within the group |
|
115 # row => row number that the group starts at within the super grid |
|
116 # |
|
117 |
|
118 |
|
119 # |
|
120 # Flags |
|
121 my $displayObjectAddressFlag = 0; # display object hex address alongside name |
|
122 my $displayObjectExecutable = 1; # display object executable alongside name |
|
123 |
|
124 my $group = 1; # next free group number (monotonically incremented after allocation) |
|
125 |
|
126 my @colToSubColIndex; |
|
127 my @rowToSubRowIndex; |
|
128 my @rowToSubGridHeight; |
|
129 my @colToSubGridWidth; |
|
130 my @objects; |
|
131 my @subGridRow; |
|
132 my @subGridPlacement; |
|
133 my %relationships; |
|
134 my %groupRanges; |
|
135 |
|
136 my @animateSequence; |
|
137 my %animateVisible; |
|
138 |
|
139 my %nodeToExe; # map subsession nodes (e.g. Socket) to their executable |
|
140 my %directionTranslate = ( n => { x => 0, y => -1 }, |
|
141 s => { x => 0, y => +1 }, |
|
142 w => { x => -1, y => 0 }, |
|
143 e => { x => +1, y => 0 } ); |
|
144 |
|
145 my %initRange = ( minCol => 9999, minRow => 9999, maxCol => -9999, maxRow => -9999 ); |
|
146 my %overallRange = %initRange; |
|
147 |
|
148 # tabLabel is a monotonically increasing value used to derive a unique Tab Label. It is incremented |
|
149 # everytime a new Tab is drawn. |
|
150 |
|
151 my $tabLabel = "a"; |
|
152 |
|
153 # minor aesthetic adjustments to the spacing between the end of a Tab line and its Labels |
|
154 my $tabToFontAdjustTopY = 2; |
|
155 my $tabToFontAdjustBottomY = 1; |
|
156 my $tabLineLengthY = 5; |
|
157 |
|
158 our($opt_x,$opt_v,$opt_V); |
|
159 Getopts("x:vV"); |
|
160 readRelationshipFile(); |
|
161 |
|
162 print "Reading sequences\n" if ($opt_V); |
|
163 readSequences(); |
|
164 #printGroupRanges(); |
|
165 |
|
166 #printRelationships(); |
|
167 print "Normalising coordinates\n" if ($opt_V); |
|
168 normaliseCoords(); |
|
169 print "Seperating groups\n" if ($opt_V); |
|
170 seperateGroups(); |
|
171 print "Seperating overlaps\n" if ($opt_V); |
|
172 seperateOverlaps(); |
|
173 |
|
174 # print2DArray("subGridPlacement", \@subGridPlacement); |
|
175 |
|
176 print "Calculating grid positions\n" if ($opt_V); |
|
177 calculateGridPositions(); |
|
178 |
|
179 if ($opt_v) { |
|
180 printArray("colToSubColIndex", \@colToSubColIndex); |
|
181 printArray("rowToSubRowIndex", \@rowToSubRowIndex); |
|
182 |
|
183 printArray("rowToSubGridHeight", \@rowToSubGridHeight); |
|
184 printArray("colToSubGridWidth", \@colToSubGridWidth); |
|
185 |
|
186 printLoners(); |
|
187 printRelationships(); |
|
188 printGroupRanges(); |
|
189 } |
|
190 |
|
191 my $fontHeight = 9; # assumed font height |
|
192 my $groupHighlightFill = "rgb(235,235,235)"; |
|
193 my $groupHighlightMargin = 5; # margin of the group background rectangle |
|
194 |
|
195 my $horizMargin = 20; |
|
196 my $vertMargin = $horizMargin; |
|
197 |
|
198 my $gridXSpacing = $horizMargin; |
|
199 my $gridYSpacing = $gridXSpacing; |
|
200 |
|
201 my $rectangleMargin = 10; |
|
202 my $rectangleWidth = 110; |
|
203 my $rectangleHeight = 27; |
|
204 my $rectangleWidthWithMargin = $rectangleWidth + $rectangleMargin; |
|
205 my $rectangleHeightWithMargin = $rectangleHeight + $rectangleMargin; |
|
206 |
|
207 my $rectangleOpacity = 0.80; |
|
208 my $rectangleColour1 = "lightgreen"; |
|
209 my $rectangleColour2 = "lightskyblue"; |
|
210 my $rectHighlightColour = "salmon"; |
|
211 |
|
212 # X position of last grid column + size of last grid column + horizontal margin |
|
213 my $width = gridX($#colToSubColIndex) + $colToSubGridWidth[$#colToSubColIndex] * $rectangleWidthWithMargin + $horizMargin; |
|
214 my $height = gridY($#rowToSubRowIndex) + $rowToSubGridHeight[$#subGridRow] * $rectangleHeightWithMargin + $vertMargin; |
|
215 |
|
216 createOutputFile(); |
|
217 outputDocHeader($width,$height); |
|
218 outputGroupHighlight(); |
|
219 print "Generating links\n" if ($opt_V); |
|
220 outputLinks(); |
|
221 print "Generating nodes\n" if ($opt_V); |
|
222 outputNodes(); |
|
223 outputDocFooter(); |
|
224 closeOutputFile(); |
|
225 outputRelationsHTMLEmbedder($width, $height); |
|
226 |
|
227 sub createOutputFile() |
|
228 { |
|
229 open SVG, ">relations.svg" || die "Cannot open relations.svg for writing\n"; |
|
230 } |
|
231 |
|
232 sub closeOutputFile() |
|
233 { |
|
234 close SVG; |
|
235 } |
|
236 sub readSequences() |
|
237 { |
|
238 while (<>) { |
|
239 die unless s/^(\w+)\s+//; |
|
240 my $action = $1; |
|
241 if ($action eq "p" || $action eq "r" || $action eq "sc") |
|
242 { |
|
243 # Post/Receive |
|
244 # [P|R] <message> <source object> <destination object> |
|
245 my $msg; |
|
246 if (/^"/) |
|
247 { |
|
248 s/^"([^"]+)"\s+//; # deal with quoted strings: "..." |
|
249 $msg = $1; |
|
250 } |
|
251 else |
|
252 { |
|
253 s/^(\S+)\s+//; |
|
254 $msg = $1; |
|
255 } |
|
256 $msg =~ s/ \(.*\)//; # remove message arguments in parentheses: "<message>(<arguments>)" => "<message>" |
|
257 split; |
|
258 my $srcRef = findOrCreateObject(shift @_); |
|
259 my $destRef = findOrCreateObject(shift @_); |
|
260 my $direction = $relationships{$msg}; |
|
261 if ($direction) { |
|
262 if (isDirection($direction)) { |
|
263 AddRelation($srcRef, $destRef, $direction); |
|
264 } |
|
265 } |
|
266 elsif ($srcRef != $destRef) { |
|
267 # print "Unknown relationship: $srcRef->{Name} -- $msg --> $destRef->{Name}\n"; |
|
268 } |
|
269 AnimateObjectMessage($srcRef, $destRef, $direction) if $animate; |
|
270 } |
|
271 elsif ($action eq "oc") |
|
272 { |
|
273 # Object Create |
|
274 # oc <object name> <order> <addr> |
|
275 split; |
|
276 my $objRef = findOrCreateObject(shift @_); |
|
277 shift @_; # order - can we use this to define object column placement ? |
|
278 $objRef->{Addr} = shift @_; |
|
279 AnimateObjectCreate($objRef) if $animate; |
|
280 } |
|
281 elsif ($action eq "od") |
|
282 { |
|
283 # Object Destroy |
|
284 # od <object name> <addr> |
|
285 split; |
|
286 my $objRef = findObject(shift @_); |
|
287 if ($objRef != 0) { |
|
288 AnimateObjectDestroy($objRef) if $animate; |
|
289 } |
|
290 } |
|
291 |
|
292 elsif ($action eq "t" && $displayObjectExecutable) |
|
293 { |
|
294 # Text |
|
295 # We are trying to to create a map of subsessions to the executables that are using them, |
|
296 # (e.g. Socket1 -> dnd). To do this, we need to search for the special "t" entries of the form: |
|
297 # |
|
298 # t !tester ESoSendToNoLength(Socket) |
|
299 # |
|
300 m/(\S+) (\S+)/; |
|
301 my $exe = $1; |
|
302 my $ipc = $2; |
|
303 if ($exe =~ s/^!//) |
|
304 { |
|
305 if ($ipc =~ m/E\w+\(([A-Z]\w+)\)/) |
|
306 { |
|
307 if (! defined $nodeToExe{$1}) |
|
308 { |
|
309 $nodeToExe{$1} = $exe; |
|
310 } |
|
311 elsif ($nodeToExe{$1} ne $exe) |
|
312 { |
|
313 # error - we have more than one node that seems to be using the same subsession. |
|
314 # Null out the hash entry - it won't be overwritten. |
|
315 $nodeToExe{$1} = ""; |
|
316 } |
|
317 } |
|
318 } |
|
319 } |
|
320 } |
|
321 } |
|
322 |
|
323 sub AddRelation($$$) |
|
324 { |
|
325 my ($srcRef,$destRef,$dir) = @_; |
|
326 |
|
327 my $rdir = reverseDirection($dir); |
|
328 |
|
329 if ($srcRef != $destRef && ! RelationExists($srcRef->{$dir}, $destRef)) |
|
330 { |
|
331 push @{$srcRef->{$dir}}, $destRef; |
|
332 push @{$destRef->{$rdir}}, $srcRef; |
|
333 |
|
334 # my %range = %initRange; |
|
335 |
|
336 # we are about to merge groups, so delete the group about to be assimilated from the group ranges hash |
|
337 delete $groupRanges{$destRef->{group}}; |
|
338 |
|
339 my $rangeRef = \%{$groupRanges{$srcRef->{group}}}; |
|
340 |
|
341 |
|
342 MergeGroups($destRef->{group}, $srcRef->{group}, |
|
343 $srcRef->{col} + $directionTranslate{$dir}{x} - $destRef->{col}, |
|
344 $srcRef->{row} + $directionTranslate{$dir}{y} - $destRef->{row}, $rangeRef ); |
|
345 |
|
346 # MergeGroups() above will automatically adjust the min/max range values in range for all the "incoming" |
|
347 # objects. However, we still have to take into account the effect that the original src object has on |
|
348 # the min/max range values, so call updateRange() specially here for it. |
|
349 updateRange($rangeRef, $srcRef->{col}, $srcRef->{row}); |
|
350 |
|
351 # Ultimately we need to place objects on the super grid according to what type they are - for example, |
|
352 # flows in col 0, SCPRs in col 1 etc. At the moment, they are mixed up in the same super grid, as |
|
353 # some groups may have flow, some may not, but all groups are left aligned. This explains why |
|
354 # the display is messed up with MCPRs and CPRs occupying the same column in different groups. |
|
355 |
|
356 updateRange(\%overallRange, $rangeRef->{minCol}, $rangeRef->{minRow}); |
|
357 updateRange(\%overallRange, $rangeRef->{maxCol}, $rangeRef->{maxRow}); |
|
358 } |
|
359 } |
|
360 |
|
361 # |
|
362 # Indicate whether the string passed is a (compass) direction. |
|
363 # |
|
364 sub isDirection($) |
|
365 { |
|
366 my $dir = $_[0]; |
|
367 return $dir eq "n" || $dir eq "s" || $dir eq "w" || $dir eq "e"; |
|
368 } |
|
369 |
|
370 sub MergeGroups($$$$) |
|
371 { |
|
372 my ($targetGroup, $newGroup, $adjustCol, $adjustRow, $rangeRef) = @_; |
|
373 foreach my $obj (@objects) { |
|
374 if ($obj->{group} == $targetGroup) { |
|
375 $obj->{group} = $newGroup; |
|
376 $obj->{col} += $adjustCol; |
|
377 $obj->{row} += $adjustRow; |
|
378 # determine minimum and maximum row,col extent of group |
|
379 updateRange($rangeRef, $obj->{col}, $obj->{row}); |
|
380 } |
|
381 } |
|
382 } |
|
383 |
|
384 sub updateRange($range, $col, $row) |
|
385 { |
|
386 my ($range, $col, $row) = @_; |
|
387 if (!defined($range->{maxCol}) || $col > $range->{maxCol}) { |
|
388 $range->{maxCol} = $col; |
|
389 } |
|
390 if (!defined($range->{maxRow}) || $row > $range->{maxRow}) { |
|
391 $range->{maxRow} = $row; |
|
392 } |
|
393 if (!defined($range->{minCol}) || $col < $range->{minCol}) { |
|
394 $range->{minCol} = $col; |
|
395 } |
|
396 if (!defined($range->{minRow}) || $row < $range->{minRow}) { |
|
397 $range->{minRow} = $row; |
|
398 } |
|
399 } |
|
400 |
|
401 sub RelationExists($$) |
|
402 { |
|
403 my ($relationArrayRef, $objRef) = @_; |
|
404 |
|
405 if (defined ($relationArrayRef)) |
|
406 { |
|
407 foreach my $obj (@{$relationArrayRef}) |
|
408 { |
|
409 if ($obj == $objRef) |
|
410 { |
|
411 return 1; |
|
412 } |
|
413 } |
|
414 } |
|
415 else |
|
416 { |
|
417 return 0; |
|
418 } |
|
419 } |
|
420 |
|
421 sub reverseDirection($) |
|
422 { |
|
423 my ($dir) = @_; |
|
424 my %reverseMap = ( "n" => "s", "s" => "n", "w" => "e", "e" => "w" ); |
|
425 return $reverseMap{$dir}; |
|
426 } |
|
427 |
|
428 # |
|
429 # Print objects that exchange no messages with anyone else. |
|
430 # |
|
431 sub printLoners() |
|
432 { |
|
433 my $wrapCount = 8; |
|
434 my $wrapIndex = 1; |
|
435 print "Loners:\t"; |
|
436 my $commaRequired = 0; |
|
437 for (my $i = 0 ; $i <= $#objects ; ++$i) |
|
438 { |
|
439 my $obj = $objects[$i]; |
|
440 if (!defined($obj->{subCol}) && !defined($obj->{subRow})) |
|
441 { |
|
442 if ($commaRequired != 0) |
|
443 { |
|
444 print ", "; |
|
445 } |
|
446 $commaRequired = 1; |
|
447 print $obj->{Name}; |
|
448 if (($wrapIndex++ % $wrapCount) == 0) |
|
449 { |
|
450 $commaRequired = 0; |
|
451 print "\n\t"; |
|
452 } |
|
453 } |
|
454 } |
|
455 print "\n\n"; |
|
456 } |
|
457 |
|
458 sub printRelationships() |
|
459 { |
|
460 print "Relationships - overallRange: ($overallRange{minCol}, $overallRange{minRow}) to ($overallRange{maxCol}, $overallRange{maxRow}):\n"; |
|
461 my $i; |
|
462 for ($i = 0 ; $i < scalar(@objects) ; ++$i) |
|
463 { |
|
464 printObjectRelationships($objects[$i]); |
|
465 } |
|
466 print "\n"; |
|
467 } |
|
468 |
|
469 sub printObjectRelationships($) |
|
470 { |
|
471 my ($obj) = @_; |
|
472 |
|
473 # Object |
|
474 print $obj->{Name}, ": group $obj->{group}, ($obj->{col},$obj->{row}), sub ($obj->{subCol},$obj->{subRow})\n"; |
|
475 |
|
476 # North |
|
477 if (defined($obj->{n})) |
|
478 { |
|
479 print "\tN: "; |
|
480 printObjects($obj->{n}); |
|
481 print "\n"; |
|
482 } |
|
483 |
|
484 # West |
|
485 if (defined($obj->{w})) |
|
486 { |
|
487 print "\tW: "; |
|
488 printObjects($obj->{w}); |
|
489 print "\n"; |
|
490 } |
|
491 |
|
492 |
|
493 # East |
|
494 if (defined($obj->{e})) |
|
495 { |
|
496 print "\tE: "; |
|
497 printObjects($obj->{e}); |
|
498 print "\n"; |
|
499 } |
|
500 |
|
501 # South |
|
502 if (defined($obj->{s})) |
|
503 { |
|
504 print "\tS: "; |
|
505 printObjects($obj->{s}); |
|
506 print "\n"; |
|
507 } |
|
508 |
|
509 print "\n"; |
|
510 } |
|
511 |
|
512 sub printObjects($) |
|
513 { |
|
514 my ($relationArray) = @_; |
|
515 |
|
516 my $commaRequired = 0; |
|
517 foreach my $obj (@{$relationArray}) |
|
518 { |
|
519 if ($commaRequired == 1) |
|
520 { |
|
521 print ", "; |
|
522 } |
|
523 print $obj->{Name}; |
|
524 $commaRequired = 1; |
|
525 } |
|
526 } |
|
527 |
|
528 sub findObject($) |
|
529 { |
|
530 my $objName = $_[0]; |
|
531 my $i; |
|
532 for ($i = 0 ; $i < scalar(@objects) ; ++$i) { |
|
533 if ($objects[$i]{Name} eq $objName) { |
|
534 return $objects[$i]; |
|
535 } |
|
536 } |
|
537 return 0; |
|
538 } |
|
539 |
|
540 sub findOrCreateObject($) |
|
541 { |
|
542 my $objName = $_[0]; |
|
543 my $objRef = findObject($objName); |
|
544 if ($objRef != 0) { |
|
545 return $objRef; |
|
546 } |
|
547 else { |
|
548 my $objectCount = scalar(@objects); |
|
549 $objects[$objectCount] = { Name => $objName, row => 0, col => 0, group => $group++ }; |
|
550 # print "findOrCreateObject: $objects[$i]->{Name}, group $objects[$i]->{group}, ($objects[$i]->{col},$objects[$i]->{row})\n"; |
|
551 return $objects[$objectCount]; |
|
552 } |
|
553 } |
|
554 |
|
555 sub readRelationshipFile() |
|
556 { |
|
557 if ($opt_x) { |
|
558 open (REL, $opt_x) || die "Cannot open exclude file $opt_x\n"; |
|
559 while (<REL>) { |
|
560 chomp; |
|
561 # remove leading and trailing blanks and ignore blank lines |
|
562 s/^\s+//; |
|
563 s/\s+$//; |
|
564 if (! $_) |
|
565 { next; }; |
|
566 |
|
567 my ($message,$direction) = split; |
|
568 $relationships{$message} = $direction; |
|
569 } |
|
570 close REL; |
|
571 } |
|
572 } |
|
573 |
|
574 ####################### |
|
575 # SVG output routines |
|
576 ####################### |
|
577 |
|
578 sub outputDocHeader() |
|
579 { |
|
580 my ($width,$height) = @_; |
|
581 print SVG '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>',"\n"; |
|
582 print SVG '<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">',"\n"; |
|
583 print SVG "<svg id=\"svgroot\" height=\"$height\" width=\"$width\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\">\n"; |
|
584 # place popup rectangle before all other text, otherwise it will be on top of rather than |
|
585 # underneath the popup text |
|
586 } |
|
587 |
|
588 sub outputGroupStart($) |
|
589 { |
|
590 my $id = $_[0]; |
|
591 print SVG qq{<g id="${id}">\n}; |
|
592 } |
|
593 |
|
594 sub outputGroupEnd() |
|
595 { |
|
596 print SVG "</g>\n"; |
|
597 } |
|
598 |
|
599 sub outputText($$$$$$) |
|
600 { |
|
601 my ($x,$text,$y,$anchor,$otherSvgAttr,$colour) = @_; |
|
602 |
|
603 my $attrs = qq{ x="$x" y="$y" }; |
|
604 |
|
605 if ($otherSvgAttr) |
|
606 { |
|
607 $attrs .= qq { $otherSvgAttr }; |
|
608 } |
|
609 |
|
610 if ($anchor) |
|
611 { |
|
612 $attrs .= qq { text-anchor="$anchor" }; |
|
613 } |
|
614 |
|
615 if ($colour) |
|
616 { |
|
617 if ($colour =~ s/^!//) |
|
618 { |
|
619 outputRect($x - 1, $y - $fontHeight, 3, $fontHeight, "white", "white", ""); |
|
620 } |
|
621 if ($colour) |
|
622 { |
|
623 $attrs .= qq { fill="$colour" }; |
|
624 } |
|
625 } |
|
626 |
|
627 print SVG "<text $attrs>$text</text>\n"; |
|
628 } |
|
629 |
|
630 sub outputLine($$$$$$) |
|
631 { |
|
632 my ($x1,$y1,$x2,$y2,$colour,$otherAttr) = @_; |
|
633 |
|
634 if (! $colour) { |
|
635 $colour = "black"; |
|
636 } |
|
637 |
|
638 print SVG qq{<line stroke="$colour" x1="$x1" y1="$y1" x2="$x2" y2="$y2" $otherAttr}; |
|
639 |
|
640 my $id = getAttr("id", $otherAttr); |
|
641 print SVG qq{ />\n}; |
|
642 } |
|
643 |
|
644 |
|
645 sub getAttr($$) |
|
646 { |
|
647 my ($attr,$attrList) = @_; |
|
648 if ($attrList =~ m/${attr}="([^"]+)"/) { |
|
649 return $1; |
|
650 } else { |
|
651 return; |
|
652 } |
|
653 } |
|
654 |
|
655 sub outputRect($$$$$$$) |
|
656 { |
|
657 my ($x,$y,$width,$height,$fill,$stroke,$otherAttr) = @_; |
|
658 print SVG qq {<rect fill="$fill" stroke="$stroke" x="$x" y="$y" width="$width" height="$height" $otherAttr}; |
|
659 |
|
660 my $id = getAttr("id", $otherAttr); |
|
661 print SVG qq{ />\n}; |
|
662 } |
|
663 |
|
664 sub outputDocFooter() |
|
665 { |
|
666 print SVG "<script><![CDATA[\n"; |
|
667 AnimateDo() if ($animate); |
|
668 ################################### |
|
669 # Begin Interpolated Text... # |
|
670 ################################### |
|
671 print SVG <<'EOT' |
|
672 var highlightedNodes = new Array(); |
|
673 var highlightedNodesAttr = new Array(); |
|
674 bindToParent(); |
|
675 |
|
676 initAnimate(); |
|
677 |
|
678 function bindToParent() |
|
679 { |
|
680 parent.relationsMessageHighlightPtr = messageHighlight; |
|
681 parent.relationsObjectHighlightPtr = objectHighlight; |
|
682 |
|
683 // Allow for animation.html to call into us when one of its buttons is pressed. |
|
684 parent.relationsCommandPtr = animateCommand; |
|
685 } |
|
686 |
|
687 function sequenceMessageHighlight(id) { |
|
688 if (!opener.closed) { |
|
689 opener.sequenceMessageHighlightPtr(id); |
|
690 } |
|
691 } |
|
692 |
|
693 function sequenceObjectHighlight(id) { |
|
694 if (!opener.closed) { |
|
695 opener.sequenceObjectHighlightPtr(id); |
|
696 } |
|
697 } |
|
698 |
|
699 function MessageEvent(evt) |
|
700 { |
|
701 sequenceMessageHighlight(evt.currentTarget.id); |
|
702 messageHighlight(evt.currentTarget.id); |
|
703 } |
|
704 |
|
705 function NodeEvent(evt) |
|
706 { |
|
707 sequenceObjectHighlight(evt.currentTarget.id); |
|
708 objectHighlight(evt.currentTarget.id); |
|
709 } |
|
710 |
|
711 function display(obj) |
|
712 { |
|
713 var s = ""; |
|
714 var t = ""; |
|
715 for (i in obj) |
|
716 { |
|
717 t = typeof obj[i]; |
|
718 s += i + " = "; |
|
719 if (t != "unknown") { |
|
720 var u = ""; |
|
721 u += obj[i]; |
|
722 if (u.indexOf("function") < 0) |
|
723 { |
|
724 s += u; |
|
725 } |
|
726 else |
|
727 { |
|
728 s += "(function)"; |
|
729 } |
|
730 } |
|
731 else |
|
732 { |
|
733 s += "(unknown)"; |
|
734 } |
|
735 s += ", "; |
|
736 } |
|
737 alert(s); |
|
738 } |
|
739 |
|
740 function messageHighlight(nodeNamesString) |
|
741 { |
|
742 // given a string "x_y" find all nodes with tags "x", "y", "x_y" or "y_x" |
|
743 var nodeNames = nodeNamesString.split("_", 2); |
|
744 |
|
745 if (nodeNames.length == 2) |
|
746 { |
|
747 UnhighlightCurrentNodes(); |
|
748 var nodeList = document.getElementsByTagName("*"); |
|
749 var count = nodeList.length; |
|
750 var el; |
|
751 var reverseNodeNamesString = nodeNames[1] + "_" + nodeNames[0]; |
|
752 highlightIndex = 0; |
|
753 for (i = 0 ; i < count ; i++) |
|
754 { |
|
755 el = nodeList.item(i); |
|
756 if (el.id == nodeNames[0] || el.id == nodeNames[1] || el.id == nodeNamesString || el.id == reverseNodeNamesString) |
|
757 { |
|
758 highlightNode(el); |
|
759 } |
|
760 } |
|
761 } |
|
762 } |
|
763 |
|
764 function objectHighlight(nodeNameString) |
|
765 { |
|
766 // given a string "x" find all nodes with tag "x" |
|
767 UnhighlightCurrentNodes(); |
|
768 |
|
769 // OPTIMISE nodeList |
|
770 var nodeList = document.getElementsByTagName("*"); |
|
771 var count = nodeList.length; |
|
772 var el; |
|
773 for (i = 0 ; i < count ; i++) |
|
774 { |
|
775 el = nodeList.item(i); |
|
776 if (el.id == nodeNameString) |
|
777 { |
|
778 highlightNode(el); |
|
779 } |
|
780 } |
|
781 } |
|
782 |
|
783 function highlightNode(el) |
|
784 { |
|
785 if (el.tagName == "rect") |
|
786 { |
|
787 highlightedNodes.push(el); |
|
788 highlightedNodesAttr.push(el.getAttribute("fill")); |
|
789 el.setAttribute("fill", "lightsalmon"); |
|
790 } |
|
791 } |
|
792 |
|
793 function UnhighlightCurrentNodes() |
|
794 { |
|
795 while(highlightedNodes.length > 0) |
|
796 { |
|
797 highlightedNodes.pop().setAttribute("fill", highlightedNodesAttr.pop()); |
|
798 } |
|
799 } |
|
800 |
|
801 function matchName(name, targetName) |
|
802 { |
|
803 var nameLen = name.length; |
|
804 var targetNameLen = targetName.length; |
|
805 var pos, underlinePos; |
|
806 |
|
807 pos = targetName.indexOf(name); |
|
808 if (pos != -1) |
|
809 { |
|
810 // check for exact match |
|
811 if (pos == 0 && nameLen == targetNameLen) |
|
812 { |
|
813 return true; |
|
814 } |
|
815 else |
|
816 { |
|
817 // match "x" against "x_y" or "y_x" |
|
818 underlinePos = targetName.indexOf("_"); |
|
819 if ( underlinePos != -1 && ((pos == 0 && underlinePos == nameLen) || (pos == targetNameLen - nameLen)) ) |
|
820 { |
|
821 return true; |
|
822 } |
|
823 } |
|
824 } |
|
825 return false; |
|
826 } |
|
827 ]]></script> |
|
828 </svg> |
|
829 EOT |
|
830 ################################# |
|
831 # ...End Interpolated Text # |
|
832 ################################# |
|
833 } |
|
834 |
|
835 sub outputRelationsHTMLEmbedder($$) |
|
836 { |
|
837 my ($width,$height) = @_; |
|
838 open HTML, ">relations.html" || die "Cannot open relations.html for writing\n"; |
|
839 print HTML qq{<html>\n<body onLoad="resize()">\n}; |
|
840 print HTML qq{<embed src="relations.svg" width="$width" height="$height" type="image/svg+xml" pluginspage="http://www.adobe.com/svg/viewer/install/" name="embedder">\n}; |
|
841 print HTML qq{<input type="button" value="Animate..." onclick="popupAnimate()">\n}; |
|
842 print HTML qq{<script type="text/javascript">\n}; |
|
843 print HTML "var relationsWidth = $width;\n"; |
|
844 print HTML "var relationsHeight = $height;\n"; |
|
845 print HTML "var maxPopupHeight = $maxRelationsPopupHeight;\n"; |
|
846 ################################# |
|
847 # Begin Interpolated Text... # |
|
848 ################################# |
|
849 print HTML<<'EOT' |
|
850 function resize() { |
|
851 // Try to resize so that relations diagram is fully visible without scrollbars. |
|
852 var height = relationsHeight + ((opener != null) ? 130 : 220); |
|
853 if (height > maxPopupHeight) { |
|
854 height = maxPopupHeight; |
|
855 } |
|
856 window.resizeTo(relationsWidth + 55, height); |
|
857 } |
|
858 |
|
859 function popupAnimate() { |
|
860 animate = window.open("animate.html", "_blank", "resizable=yes,scrollbars=yes"); |
|
861 } |
|
862 |
|
863 </script> |
|
864 </body></html> |
|
865 EOT |
|
866 ; |
|
867 ################################# |
|
868 # ...End Interpolated Text # |
|
869 ################################# |
|
870 close HTML; |
|
871 } |
|
872 |
|
873 # |
|
874 # Output the "animate.html" file that creates the animate "control panel" popup |
|
875 # |
|
876 sub outputAnimateHTML() |
|
877 { |
|
878 open HTML, ">animate.html" || die "Cannot open animate.html for writing\n"; |
|
879 ################################# |
|
880 # Begin Interpolated Text... # |
|
881 ################################# |
|
882 print HTML<<'EOT' |
|
883 <html> |
|
884 <body onLoad="load()"> |
|
885 <input type="button" value="Rewind" onclick="rewind()"> |
|
886 <input type="button" value="Play" onclick="play()"> |
|
887 <input type="button" value="Stop" onclick="stop()"> |
|
888 <input type="button" value="Step +" onclick="stepForward()"> |
|
889 <input type="button" value="Step -" onclick="stepBackward()"> |
|
890 <input type="button" value="Restore" onclick="restore()"> |
|
891 <script type="text/javascript"> |
|
892 function load() { |
|
893 window.resizeTo(400, 130); |
|
894 } |
|
895 |
|
896 function play() |
|
897 { |
|
898 if (!opener.closed) { |
|
899 // Call into relations.svg via the relationsCommandPtr property that relations.svg has set in |
|
900 // its parent relations.html. |
|
901 opener.relationsCommandPtr("p"); |
|
902 } |
|
903 } |
|
904 |
|
905 function rewind() |
|
906 { |
|
907 if (!opener.closed) { |
|
908 opener.relationsCommandPtr("rw"); |
|
909 } |
|
910 } |
|
911 |
|
912 function stop() |
|
913 { |
|
914 if (!opener.closed) { |
|
915 opener.relationsCommandPtr("s"); |
|
916 } |
|
917 } |
|
918 |
|
919 function stepForward() |
|
920 { |
|
921 if (!opener.closed) { |
|
922 opener.relationsCommandPtr("+"); |
|
923 } |
|
924 } |
|
925 |
|
926 function stepBackward() |
|
927 { |
|
928 if (!opener.closed) { |
|
929 opener.relationsCommandPtr("-"); |
|
930 } |
|
931 } |
|
932 |
|
933 function restore() |
|
934 { |
|
935 if (!opener.closed) { |
|
936 opener.relationsCommandPtr("rs"); |
|
937 } |
|
938 } |
|
939 |
|
940 </script> |
|
941 </body></html> |
|
942 EOT |
|
943 ; |
|
944 ################################# |
|
945 # ...End Interpolated Text # |
|
946 ################################# |
|
947 close HTML; |
|
948 } |
|
949 |
|
950 |
|
951 sub outputNodes() |
|
952 { |
|
953 my $obj; |
|
954 foreach $obj (@objects) { |
|
955 if (hasRelationships($obj)) { |
|
956 # |
|
957 # figure out the colours to use, based on a chequer board pattern |
|
958 # |
|
959 my $colour; |
|
960 if ($obj->{col} & 1) { |
|
961 $colour = $rectangleColour1; |
|
962 } else { |
|
963 $colour = $rectangleColour2; |
|
964 } |
|
965 outputRect(objectX($obj), objectY($obj), |
|
966 $rectangleWidth, $rectangleHeight, |
|
967 $colour, "black", qq{ onclick="NodeEvent(evt)" opacity="$rectangleOpacity" id="$obj->{Name}" } ); |
|
968 |
|
969 # my $debug="-" . $obj->{group} . "(" . $obj->{col} . "," . $obj->{row} . ")(" . $obj->{subCol} . "," . $obj->{subRow} . ")"; |
|
970 my $midPointX = objectX($obj) + ($rectangleWidth/2); |
|
971 |
|
972 my $objName = $obj->{Name}; |
|
973 my $secondLine = ""; # if non-null, second line of text below the object name |
|
974 |
|
975 if ($displayObjectAddressFlag) { |
|
976 $secondLine = $obj->{Addr}; |
|
977 } |
|
978 |
|
979 if ($displayObjectExecutable && defined $nodeToExe{$objName}) { |
|
980 my $exe = $nodeToExe{$objName}; |
|
981 if ($exe ne "") { |
|
982 $secondLine .= "($exe)"; |
|
983 } |
|
984 } |
|
985 |
|
986 my $spacingY = ($rectangleHeight + $fontHeight); |
|
987 if ($secondLine ne "") { |
|
988 $spacingY /= 3; |
|
989 } else { |
|
990 $spacingY /= 2; |
|
991 } |
|
992 |
|
993 # |
|
994 # If outputting multiple text elements in a rectangle, group ("<g>") them so that we can animate them |
|
995 # together via the group. If using the group, it gets the id name "<object>_t". If using a |
|
996 # single text element, the group isn't used and the single text element carries the id name instead. |
|
997 # From the perspective of the animate, it will just animate object with tag "<object>_t", which |
|
998 # will automatically either be single text element or the group of several text elements. |
|
999 # |
|
1000 |
|
1001 my $id = $obj->{Name} . "_t"; |
|
1002 if ($animate && $secondLine) { |
|
1003 outputGroupStart($id); |
|
1004 # don't need to assign id to any text elements below as it is assigned to the group |
|
1005 $id = ""; |
|
1006 } else { |
|
1007 # no group - assign id to the (single) text element below |
|
1008 $id = qq{id="$id"}; |
|
1009 } |
|
1010 |
|
1011 outputText($midPointX, |
|
1012 $objName . $debug, |
|
1013 objectY($obj) + $spacingY, |
|
1014 "middle", qq{$id onclick="NodeEvent(evt)"}, "black"); |
|
1015 |
|
1016 if ($secondLine ne "") { |
|
1017 outputText($midPointX, |
|
1018 $secondLine, |
|
1019 objectY($obj) + 2*$spacingY, |
|
1020 "middle", qq{onclick="NodeEvent(evt)"}, "black"); |
|
1021 } |
|
1022 if ($animate && $secondLine) { |
|
1023 outputGroupEnd(); |
|
1024 } |
|
1025 } |
|
1026 } |
|
1027 } |
|
1028 |
|
1029 sub outputLinks() |
|
1030 { |
|
1031 my $obj; |
|
1032 foreach $obj (@objects) { |
|
1033 # relationships between objects are symmetrical in both directions, so only need to display |
|
1034 # one each of west/east and north/south. |
|
1035 if ($obj->{n}) { |
|
1036 foreach my $obj2 (@{$obj->{n}}) { |
|
1037 if (checkOverlap($obj, $obj2) == 1) |
|
1038 { |
|
1039 # ++$gridVerticalLineCount[$obj->{col}]; |
|
1040 my $attachPoint2 = ++$obj2->{n_AttachPointCount}; |
|
1041 my $attachPoint = ++$obj->{n_AttachPointCount}; |
|
1042 outputTabConnectors($obj, "n", $attachPoint, $obj2, "s", $attachPoint2); |
|
1043 } |
|
1044 else |
|
1045 { |
|
1046 my $relationshipName = RelationshipName($obj->{Name},$obj2->{Name}); |
|
1047 outputLine(objectSideX($obj, "n", 0), objectSideY($obj, "n", 0), |
|
1048 objectSideX($obj2, "s", 0), objectSideY($obj2, "s", 0), |
|
1049 "", qq{ id="$relationshipName" onclick="MessageEvent(evt)" } ); |
|
1050 } |
|
1051 } |
|
1052 } |
|
1053 if ($obj->{w}) { |
|
1054 foreach my $obj2 (@{$obj->{w}}) { |
|
1055 if (checkOverlap($obj, $obj2) == 1) |
|
1056 { |
|
1057 # ++$gridHorizontalLineCount[$obj->{row}]; |
|
1058 my $attachPoint2 = ++$obj2->{w_AttachPointCount}; |
|
1059 my $attachPoint = ++$obj->{w_AttachPointCount}; |
|
1060 outputTabConnectors($obj, "w", $attachPoint, $obj2, "e", $attachPoint2); |
|
1061 } |
|
1062 else |
|
1063 { |
|
1064 my $relationshipName = RelationshipName($obj->{Name},$obj2->{Name}); |
|
1065 outputLine(objectSideX($obj, "w", 0), objectSideY($obj, "w", 0), |
|
1066 objectSideX($obj2, "e", 0), objectSideY($obj2, "e", 0), |
|
1067 "", qq{ id="$relationshipName" onclick="MessageEvent(evt)" }); |
|
1068 } |
|
1069 } |
|
1070 } |
|
1071 } |
|
1072 } |
|
1073 |
|
1074 |
|
1075 # |
|
1076 # Output a unique background rectangle around each group in order to highlight each group seperately |
|
1077 # |
|
1078 sub outputGroupHighlight() |
|
1079 { |
|
1080 my $x = gridX(0) - $groupHighlightMargin; |
|
1081 for my $i (keys %groupRanges) |
|
1082 { |
|
1083 my $ref = $groupRanges{$i}; |
|
1084 die "outputGroupHighlight(): minRow for group $i is non-zero ($ref->{minRow})\n" if $ref->{minRow} != 0; |
|
1085 outputRect($x, |
|
1086 gridY($ref->{row}) - $groupHighlightMargin, |
|
1087 $width, |
|
1088 gridHeight($ref->{row}, $ref->{maxRow} + 1) + $groupHighlightMargin * 2, |
|
1089 # $groupHighlightFill, "", qq { onclick="debugEvent(evt)" } ); |
|
1090 $groupHighlightFill, "", ""); |
|
1091 } |
|
1092 } |
|
1093 |
|
1094 # |
|
1095 # Check if a line drawn between two objects will cross through another object |
|
1096 # |
|
1097 |
|
1098 sub checkOverlap($$) |
|
1099 { |
|
1100 my ($obj, $obj2) = @_; |
|
1101 if (abs($obj->{col} - $obj2->{col}) > 1 || abs($obj->{row} - $obj2->{row}) > 1) |
|
1102 { |
|
1103 return 1; |
|
1104 print "Overlap $obj->{Name} and $obj2->{Name}\n"; |
|
1105 } |
|
1106 return 0; |
|
1107 } |
|
1108 |
|
1109 # |
|
1110 # Output labelled tabs representing the connection between two nodes which have intervening nodes (so |
|
1111 # a direct line is not possible) |
|
1112 # |
|
1113 |
|
1114 sub outputTabConnectors($$$$$$) |
|
1115 { |
|
1116 my ($obj, $dir, $attachPoint, $obj2, $dir2, $attachPoint2) = @_; |
|
1117 |
|
1118 my $objX = objectSideX($obj, $dir, $attachPoint); |
|
1119 my $objY = objectSideY($obj, $dir, $attachPoint); |
|
1120 |
|
1121 my $obj2X = objectSideX($obj2, $dir2, $attachPoint2); |
|
1122 my $obj2Y = objectSideY($obj2, $dir2, $attachPoint2); |
|
1123 |
|
1124 if ($dir eq "n") |
|
1125 { |
|
1126 if ($animate) { |
|
1127 # If animating, group together the two tabs and their accompanying |
|
1128 # text labels using a "<g>" element. We can then set the id of the group |
|
1129 # to the relationship name (e.g. "IPCPr_Conn") and animate |
|
1130 # all the pieces together. Ordinarily, a direct line is used to represent |
|
1131 # relationships and has the same id. |
|
1132 my $relationshipName = RelationshipName($obj->{Name},$obj2->{Name}); |
|
1133 outputGroupStart($relationshipName); |
|
1134 } |
|
1135 |
|
1136 # output Tabs at the top of objects - de-emphasise the tab labels with semi-condensed font option |
|
1137 outputLine($objX, $objY, $objX, $objY - $tabLineLengthY, "", ""); |
|
1138 outputText($objX, getCurrentTabLabel(), |
|
1139 $objY - $tabLineLengthY - $tabToFontAdjustTopY, |
|
1140 "middle", qq{font-stretch="semi-condensed"}, ""); |
|
1141 |
|
1142 # output Tabs at the bottom of objects |
|
1143 outputLine($obj2X, $obj2Y + $tabLineLengthY, $obj2X, $obj2Y, "", ""); |
|
1144 outputText($obj2X, getCurrentTabLabel(), $obj2Y + $tabLineLengthY + $fontHeight + $tabToFontAdjustBottomY, "middle", qq{font-stretch="semi-condensed"}, ""); |
|
1145 |
|
1146 if ($animate) { |
|
1147 outputGroupEnd(); |
|
1148 } |
|
1149 |
|
1150 incrementCurrentTabLabel(); |
|
1151 } |
|
1152 elsif ($dir eq "w") |
|
1153 { |
|
1154 } |
|
1155 else |
|
1156 { |
|
1157 die "outputTabConnectors: incorrect direction $dir\n"; |
|
1158 } |
|
1159 } |
|
1160 |
|
1161 # |
|
1162 # Return the current Tab Label string |
|
1163 # |
|
1164 sub getCurrentTabLabel() |
|
1165 { |
|
1166 return $tabLabel; |
|
1167 } |
|
1168 |
|
1169 # |
|
1170 # Increment the current Tab Label. |
|
1171 # |
|
1172 # Cycle through a-z, A-Z, 0-9 (...then funny characters I guess!) |
|
1173 # |
|
1174 sub incrementCurrentTabLabel() |
|
1175 { |
|
1176 if ($tabLabel eq "z") |
|
1177 { |
|
1178 $tabLabel = "A"; |
|
1179 } |
|
1180 elsif ($tabLabel eq "Z") |
|
1181 { |
|
1182 $tabLabel = "0"; |
|
1183 } |
|
1184 else |
|
1185 { |
|
1186 $tabLabel++; |
|
1187 } |
|
1188 } |
|
1189 |
|
1190 # |
|
1191 # Return the X position of a particular column in the super grid |
|
1192 # |
|
1193 |
|
1194 sub gridX($) |
|
1195 { |
|
1196 my ($col) = @_; |
|
1197 return $horizMargin + $colToSubColIndex[$col] * ($rectangleWidthWithMargin) + ($col * $gridXSpacing); |
|
1198 } |
|
1199 |
|
1200 # |
|
1201 # Return the Y position of a particular row in the super grid |
|
1202 # |
|
1203 |
|
1204 sub gridY($) |
|
1205 { |
|
1206 my ($row) = @_; |
|
1207 return $vertMargin + $rowToSubRowIndex[$row] * $rectangleHeightWithMargin + ($row * $gridYSpacing); |
|
1208 } |
|
1209 |
|
1210 # |
|
1211 # Return the height (pixels) of an area starting at a specified row and a number of rows high. |
|
1212 # |
|
1213 sub gridHeight($$) |
|
1214 { |
|
1215 my ($startRow,$heightInRows) = @_; |
|
1216 my $endRow = $startRow + $heightInRows - 1; |
|
1217 die "gridHeight: invalid row height $heightInRows\n" if $heightInRows <= 0; |
|
1218 |
|
1219 # calculate the number of sub rows within the area concerned |
|
1220 my $heightInSubRows = $rowToSubRowIndex[$endRow] - $rowToSubRowIndex[$startRow] + $rowToSubGridHeight[$endRow]; |
|
1221 |
|
1222 # height is: height of rectangles + height of spacing between rectangles + height of spacing between rows |
|
1223 # The "-1"s are to exclude the spacing after the last row. |
|
1224 return ($heightInSubRows * $rectangleHeight) + |
|
1225 (($heightInSubRows - 1) * $rectangleMargin) + |
|
1226 (($heightInRows - 1) * $gridYSpacing); |
|
1227 } |
|
1228 |
|
1229 |
|
1230 # |
|
1231 # Return the X position of one of the object's sides |
|
1232 # |
|
1233 # Arguments: |
|
1234 # obj object in question |
|
1235 # dir the side in question expressed as a compass point - i.e. "n", "s", "w", "e" |
|
1236 # attachPoint Used for "n" and "s" sides only. Zero means return X position of the centre position of the side. |
|
1237 # A number above zero means return the X position of a point along the side starting from its leftmost |
|
1238 # edge and increasing equi-distantly as the number increases. Used for drawing starting and ending |
|
1239 # points of a "long" line. |
|
1240 # |
|
1241 |
|
1242 sub objectSideX($$$) |
|
1243 { |
|
1244 my ($obj,$dir,$attachPoint) = @_; |
|
1245 if ($dir eq "n" || $dir eq "s") { |
|
1246 if ($attachPoint == 0) |
|
1247 { |
|
1248 return objectX($obj) + ($rectangleWidth/2); |
|
1249 } |
|
1250 else |
|
1251 { |
|
1252 # BUG - can overlap with attachPoint 0 !! |
|
1253 return objectX($obj) + ($attachPoint * 10); |
|
1254 } |
|
1255 } |
|
1256 elsif ($dir eq "w") { |
|
1257 return objectX($obj); |
|
1258 } |
|
1259 elsif ($dir eq "e") { |
|
1260 return objectX($obj) + $rectangleWidth; |
|
1261 } |
|
1262 else { |
|
1263 die "objectSideX: Bad argument (dir=$dir)\n"; |
|
1264 } |
|
1265 |
|
1266 } |
|
1267 |
|
1268 sub objectSideY($$$) |
|
1269 { |
|
1270 my ($obj,$dir,$attachPoint) = @_; |
|
1271 if ($dir eq "w" || $dir eq "e") { |
|
1272 if ($attachPoint == 0) |
|
1273 { |
|
1274 return objectY($obj) + ($rectangleHeight/2); |
|
1275 } |
|
1276 else |
|
1277 { |
|
1278 # BUG - can overlap with attachPoint 0 !! |
|
1279 return objectY($obj) + ($attachPoint * 10); |
|
1280 } |
|
1281 } |
|
1282 elsif ($dir eq "n") { |
|
1283 return objectY($obj); |
|
1284 } |
|
1285 elsif ($dir eq "s") { |
|
1286 return objectY($obj) + $rectangleHeight; |
|
1287 } |
|
1288 else { |
|
1289 die "objectSideY: Bad argument (dir=$dir)\n"; |
|
1290 } |
|
1291 |
|
1292 } |
|
1293 |
|
1294 # |
|
1295 # Return the X position of the leftmost side of an object. |
|
1296 # Calculated by taking the X position of the supergrid column that the object is within |
|
1297 # and adding this to the column within the subgrid that the object occupies, and then |
|
1298 # multiplying by the subgrid spacing. |
|
1299 # |
|
1300 # |
|
1301 # Arguments: |
|
1302 # obj object in question |
|
1303 # |
|
1304 |
|
1305 sub objectX($) |
|
1306 { |
|
1307 my $obj = $_[0]; |
|
1308 return gridX($obj->{col}) + $obj->{subCol} * $rectangleWidthWithMargin; |
|
1309 } |
|
1310 |
|
1311 sub objectY($) |
|
1312 { |
|
1313 my $obj = $_[0]; |
|
1314 return gridY($obj->{row}) + $obj->{subRow} * $rectangleHeightWithMargin; |
|
1315 } |
|
1316 |
|
1317 sub normaliseCoords() |
|
1318 { |
|
1319 print "normaliseCoords():\n"; |
|
1320 foreach $group (keys %groupRanges) { |
|
1321 my $rangeRef = $groupRanges{$group}; |
|
1322 |
|
1323 my $x = $rangeRef->{minCol}; |
|
1324 my $y = $rangeRef->{minRow}; |
|
1325 |
|
1326 print "\tgroup $group:\tmin ($rangeRef->{minCol},$rangeRef->{minRow}), max ($rangeRef->{maxCol},$rangeRef->{maxRow}) => "; |
|
1327 |
|
1328 $rangeRef->{minCol} = 0; |
|
1329 $rangeRef->{minRow} = 0; |
|
1330 $rangeRef->{maxCol} -= $x; |
|
1331 $rangeRef->{maxRow} -= $y; |
|
1332 |
|
1333 print "min ($rangeRef->{minCol},$rangeRef->{minRow}), max ($rangeRef->{maxCol},$rangeRef->{maxRow})\n"; |
|
1334 |
|
1335 foreach my $obj (@objects) { |
|
1336 if ($obj->{group} == $group) { |
|
1337 $obj->{col} -= $x; |
|
1338 $obj->{row} -= $y; |
|
1339 } |
|
1340 } |
|
1341 } |
|
1342 } |
|
1343 |
|
1344 sub seperateOverlaps() |
|
1345 { |
|
1346 my $obj; |
|
1347 foreach $obj (@objects) { |
|
1348 my $w_e_Relations = defined($obj->{w}) || defined($obj->{e}); |
|
1349 my $n_s_Relations = defined($obj->{n}) || defined($obj->{s}); |
|
1350 my $col = $obj->{col}; |
|
1351 my $row = $obj->{row}; |
|
1352 |
|
1353 # only deal with objects that have relationships to other objects |
|
1354 if ($w_e_Relations || $n_s_Relations) { |
|
1355 if (!defined($subGridPlacement[$col][$row]{subCol})) { |
|
1356 $subGridPlacement[$col][$row]{subCol} = 0; |
|
1357 $subGridPlacement[$col][$row]{subRow} = 0; |
|
1358 # print "subGridPlacement $obj->{name} [ $col, $row ] zeroed\n"; |
|
1359 } |
|
1360 else { |
|
1361 if ($w_e_Relations) { |
|
1362 ++$subGridPlacement[$col][$row]{subRow}; |
|
1363 # print "subGridPlacement $obj->{name} [ $col, $row ] subRow = ", $subGridPlacement[$col][$row]{subRow},"\n"; |
|
1364 } |
|
1365 if ($n_s_Relations) { |
|
1366 ++$subGridPlacement[$col][$row]{subCol}; |
|
1367 # print "subGridPlacement $obj->{name} [ $col, $row ] subCol = ", $subGridPlacement[$col][$row]{subCol},"\n"; |
|
1368 } |
|
1369 } |
|
1370 |
|
1371 $obj->{subCol} = $subGridPlacement[$col][$row]{subCol}; |
|
1372 $obj->{subRow} = $subGridPlacement[$col][$row]{subRow}; |
|
1373 |
|
1374 $rowToSubGridHeight[$row] = max($rowToSubGridHeight[$row], $obj->{subRow} + 1); |
|
1375 $colToSubGridWidth[$col] = max($colToSubGridWidth[$col], $obj->{subCol} + 1); |
|
1376 } |
|
1377 } |
|
1378 |
|
1379 } |
|
1380 |
|
1381 # |
|
1382 # Ensure that each distinct group is displayed in its own area of the canvas vertically. |
|
1383 # Go through and offset vertically each of the objects in the group. Also, initialise |
|
1384 # the {row} for each group in the groupRange to contain the row that the group starts at. |
|
1385 # |
|
1386 sub seperateGroups() |
|
1387 { |
|
1388 my $debug = 1; |
|
1389 if ($debug) { print "\nseperateGroups():\n"; } |
|
1390 my $row = 0; |
|
1391 foreach $group (keys %groupRanges) |
|
1392 { |
|
1393 if ($row != 0) |
|
1394 { |
|
1395 foreach my $obj (@objects) |
|
1396 { |
|
1397 if ($obj->{group} == $group) |
|
1398 { |
|
1399 $obj->{row} += $row; |
|
1400 } |
|
1401 } |
|
1402 } |
|
1403 |
|
1404 my $ref = $groupRanges{$group}; |
|
1405 if ($debug) { print "$group:\trow $row, height: ",$ref->{maxRow} - $ref->{minRow}, "\n"; } |
|
1406 $ref->{row} = $row; |
|
1407 $row += $ref->{maxRow} - $ref->{minRow} + 1; |
|
1408 } |
|
1409 if ($debug) { print "\n"; } |
|
1410 } |
|
1411 |
|
1412 sub calculateGridPositions() |
|
1413 { |
|
1414 my $total = 0; |
|
1415 my $last; |
|
1416 for (my $i = 0 ; $i < scalar(@rowToSubGridHeight) ; ++$i) { |
|
1417 $last = $rowToSubGridHeight[$i]; |
|
1418 $rowToSubRowIndex[$i] = $total; |
|
1419 $total += $last; |
|
1420 } |
|
1421 |
|
1422 $total = 0; |
|
1423 for (my $i = 0 ; $i < scalar(@colToSubGridWidth) ; ++$i) { |
|
1424 $last = $colToSubGridWidth[$i]; |
|
1425 $colToSubColIndex[$i] = $total; |
|
1426 $total += $last; |
|
1427 } |
|
1428 |
|
1429 } |
|
1430 |
|
1431 sub hasRelationships($) |
|
1432 { |
|
1433 my $objRef = $_[0]; |
|
1434 if ($objRef->{n} || $objRef->{s} || $objRef->{w} || $objRef->{e}) { |
|
1435 return 1; |
|
1436 } |
|
1437 else { |
|
1438 return 0; |
|
1439 } |
|
1440 } |
|
1441 |
|
1442 sub isRelated($$) |
|
1443 { |
|
1444 my ($srcRef, $destRef) = @_; |
|
1445 my $obj; |
|
1446 foreach my $dir ( "n", "s", "e", "w" ) { |
|
1447 if (exists $srcRef->{$dir}) { |
|
1448 foreach $obj (@{$srcRef->{$dir}}) { |
|
1449 if ($obj == $destRef) { |
|
1450 return 1; |
|
1451 } |
|
1452 } |
|
1453 } |
|
1454 } |
|
1455 return 0; |
|
1456 } |
|
1457 |
|
1458 |
|
1459 sub max($$) |
|
1460 { |
|
1461 my ($a,$b) = @_; |
|
1462 return $a > $b ? $a : $b; |
|
1463 } |
|
1464 |
|
1465 sub printArray($$) |
|
1466 { |
|
1467 my ($name,$array) = @_; |
|
1468 print $name, " (size ", scalar(@{$array}), "): "; |
|
1469 foreach my $i (@{$array}) { |
|
1470 print $i, ", "; |
|
1471 } |
|
1472 print "\n\n"; |
|
1473 } |
|
1474 |
|
1475 sub printHash($$) |
|
1476 { |
|
1477 my ($name,$hash) = @_; |
|
1478 if ($name ne "") |
|
1479 { |
|
1480 print $name, ":\t"; |
|
1481 } |
|
1482 else |
|
1483 { |
|
1484 print "\t"; |
|
1485 } |
|
1486 |
|
1487 foreach my $i (keys %{$hash}) { |
|
1488 print $i, " = ", $hash->{$i}, ", "; |
|
1489 } |
|
1490 } |
|
1491 |
|
1492 sub printGroupRanges() |
|
1493 { |
|
1494 print "\n%groupRanges:\n"; |
|
1495 foreach my $i (keys %groupRanges) { |
|
1496 printHash($i, $groupRanges{$i}); |
|
1497 print "\n"; |
|
1498 } |
|
1499 print "\n"; |
|
1500 } |
|
1501 |
|
1502 sub print2DArray($$) |
|
1503 { |
|
1504 my ($name,$array) = @_; |
|
1505 print $name, ":\n"; |
|
1506 my $index1 = 0; |
|
1507 my $index2 = 0; |
|
1508 foreach my $i (@{$array}) { |
|
1509 print "$index1:\n"; |
|
1510 $index2 = 0; |
|
1511 foreach my $j (@{$i}) { |
|
1512 print "\t"; |
|
1513 printHash($index2, $j); |
|
1514 print "\n"; |
|
1515 ++$index2; |
|
1516 } |
|
1517 ++$index1; |
|
1518 print "\n"; |
|
1519 } |
|
1520 print "\n"; |
|
1521 } |
|
1522 |
|
1523 # |
|
1524 # Given two strings, "X" and "Y", return a string of the form "X_Y" where |
|
1525 # "X" is the lexically lesser in rank. |
|
1526 # |
|
1527 # For example: "A1" and "B2" yields "A1_B2". The idea is to form a predictable |
|
1528 # and unique relationship name between two named nodes, where there are normally |
|
1529 # two possibilities (i.e. "A1_B2" and "B2_A1"). |
|
1530 |
|
1531 sub RelationshipName($$) |
|
1532 { |
|
1533 my ($name1, $name2) = @_; |
|
1534 return $name1 lt $name2 ? $name1 . "_" . $name2 : $name2 . "_" . $name1; |
|
1535 } |
|
1536 # |
|
1537 # Animation Glossary: |
|
1538 # |
|
1539 # "Node" A mesh node (e.g. "IPCPr"). Graphically represented as a box with text on front and back. |
|
1540 # "Relationship" A relationship between two nodes (e.g. "IPCPr_NetMCPr"). Graphically represented as a thin cylinder connecting the nodes. |
|
1541 # "Animate" To make a node or relationship visible. |
|
1542 # "DeAnimate" To make a node or relationship invisible. |
|
1543 # |
|
1544 |
|
1545 # |
|
1546 # Two object associated with animation: |
|
1547 # @animateSequence |
|
1548 # Array indicating the animation sequence. Each entry is a hash: |
|
1549 # Hash keys present for nodes and relationships: |
|
1550 # {action} => (integer) 0 to make node/relationship invisible, 1 to make it visible. |
|
1551 # |
|
1552 # Hash keys present only for nodes: |
|
1553 # {object} => (ref) reference into @objects entry for the node. |
|
1554 # |
|
1555 # Hash keys present only for relationships: |
|
1556 # {name} => (string) name of the relationship. |
|
1557 # {srcObj} => (ref) reference into @objects for source node. |
|
1558 # {destObj} => (ref) reference into @objects for destination node. |
|
1559 # |
|
1560 # %animateVisible |
|
1561 # Hash indicating which nodes or relationships are currently on display at the current point in the |
|
1562 # animation sequence. |
|
1563 # |
|
1564 # {<name>} = name of node or relationship, which is a hash: |
|
1565 # |
|
1566 # Keys present for nodes and relationships: |
|
1567 # {visible} => (integer). 1 if node or relationship <name> is displayed, 0 if node or relationship <name> is no longer displayed. |
|
1568 # |
|
1569 # Hash keys present only for nodes: |
|
1570 # {related} => (hash). Keys within {related} are hash are names of nodes that are |
|
1571 # related to this node and whose relationships to this node are visible. |
|
1572 |
|
1573 sub Animate($$$$) |
|
1574 { |
|
1575 my ($name, $object,$srcObject,$destObject) = @_; |
|
1576 die "Animate: null name" if (!$name); |
|
1577 |
|
1578 if ($object) { |
|
1579 # animate a node |
|
1580 $animateVisible{$name} = { visible => 1, related => {} }; # "related" = hash of names of other objects this object has a relationship with. |
|
1581 push @animateSequence, { object => $object, action => 1 }; |
|
1582 } |
|
1583 else { |
|
1584 # animate a relationship between nodes |
|
1585 $animateVisible{$name} = { visible => 1 }; |
|
1586 push @animateSequence, { srcObj => $srcObject, destObj => $destObject, name => $name, action => 1 }; |
|
1587 # for the two nodes, store the fact that each node has a relationship to the other |
|
1588 my $destName = $destObject->{Name}; |
|
1589 my $srcName = $srcObject->{Name}; |
|
1590 $animateVisible{$srcName}{related}{$destName} = 1; |
|
1591 $animateVisible{$destName}{related}{$srcName} = 1; |
|
1592 } |
|
1593 } |
|
1594 |
|
1595 sub CheckAndAnimate($$$$) |
|
1596 { |
|
1597 my ($name,$object,$srcObject,$destObject) = @_; |
|
1598 |
|
1599 # We only want to animate if the object is not already visible. Note that this is not the same the hash entry |
|
1600 # existing with $animateVisible{$name}{visible} set to 0, which means that it was animated and then de-animated. |
|
1601 # In this case, we would not want to re-animate the object, as it shouldn't be possible for the same node to |
|
1602 # be re-created (although relationships are assumed to be terminated once and never re-created between the same |
|
1603 # two nodes). |
|
1604 if (! exists($animateVisible{$name})) { |
|
1605 Animate($name, $object, $srcObject, $destObject); |
|
1606 return 1; |
|
1607 } |
|
1608 return 0; |
|
1609 } |
|
1610 |
|
1611 sub CheckAndDeAnimate($$$$) |
|
1612 { |
|
1613 my ($name, $objRef, $srcObject, $destObject) = @_; |
|
1614 # Only de-animate if the object is visible (i.e. $animateVisible{$name} exists and $animateVisible{$name}{visible} is non-zero). |
|
1615 if ($animateVisible{$name}{visible}) { |
|
1616 if ($objRef) { |
|
1617 # de-animate out relationships to this nodes that are still visible |
|
1618 # (i.e. because the appropriate "ClientLeaving" etc message has not been seen) |
|
1619 foreach my $relatedNode (keys %{$animateVisible{$name}{related}}) { |
|
1620 die "CheckAndDeAnimate: overwriting destObject" if $destObject != 0; |
|
1621 my $destObj = findObject($relatedNode); |
|
1622 my $relationshipName = RelationshipName($objRef->{Name}, $destObj->{Name}); |
|
1623 if ($animateVisible{$relationshipName}{visible}) { |
|
1624 push @animateSequence, { srcObj => $objRef, destObj => $destObj, name => $relationshipName, action => 0 }; |
|
1625 $animateVisible{$relationshipName}{visible} = 0; |
|
1626 } |
|
1627 } |
|
1628 push @animateSequence, { object => $objRef, action => 0 }; |
|
1629 } else { |
|
1630 push @animateSequence, { srcObj => $srcObject, destObj => $destObject, name => $name, action => 0 }; |
|
1631 my $destName = $destObject->{Name}; |
|
1632 my $srcName = $srcObject->{Name}; |
|
1633 delete $animateVisible{$srcName}{related}{$destName}; |
|
1634 delete $animateVisible{$destName}{related}{$srcName}; |
|
1635 } |
|
1636 $animateVisible{$name}{visible} = 0; |
|
1637 } |
|
1638 } |
|
1639 |
|
1640 # |
|
1641 # Called when a message is exchanged between two nodes. |
|
1642 # |
|
1643 sub AnimateObjectMessage($$$) |
|
1644 { |
|
1645 my ($srcRef, $destRef, $direction) = @_; |
|
1646 if ($srcRef != $destRef) { |
|
1647 my $srcName = $srcRef->{Name}; |
|
1648 my $destName = $destRef->{Name}; |
|
1649 my $relationshipName = RelationshipName($srcName, $destName); |
|
1650 if ($direction && $direction eq "~") { |
|
1651 # Relationship terminated |
|
1652 CheckAndDeAnimate($relationshipName, 0, $srcRef, $destRef); |
|
1653 } else { |
|
1654 CheckAndAnimate($relationshipName, 0, $srcRef, $destRef); |
|
1655 } |
|
1656 } |
|
1657 } |
|
1658 |
|
1659 # |
|
1660 # Called when an node is created |
|
1661 # |
|
1662 sub AnimateObjectCreate($) |
|
1663 { |
|
1664 my ($objRef) = @_; |
|
1665 my $objectName = $objRef->{Name}; |
|
1666 CheckAndAnimate($objectName, $objRef, 0, 0); |
|
1667 } |
|
1668 |
|
1669 # |
|
1670 # Called when a node is destroyed |
|
1671 # |
|
1672 sub AnimateObjectDestroy($) |
|
1673 { |
|
1674 my ($objRef) = @_; |
|
1675 my $objectName = $objRef->{Name}; |
|
1676 CheckAndDeAnimate($objectName, $objRef, 0, 0); |
|
1677 } |
|
1678 |
|
1679 sub AnimateDo() |
|
1680 { |
|
1681 AnimatePrologue(); |
|
1682 AnimateSequencerPart1(); |
|
1683 |
|
1684 # Translate the animations we have built up in @animateSequence array into a string array in the SVG file: |
|
1685 # Each entry in the array is a string which describes a step in the animation. The string is of the form: |
|
1686 # "<action>,<name>,<type>" |
|
1687 # Where: |
|
1688 # <action> = "0" for a destroy and "1" for a create |
|
1689 # <name> = name of node or relationship |
|
1690 # <type> = "n" to identify <name> as a node and "r" to identify it as a relationship. |
|
1691 # For example "1,Conn1,n", "0,IPCPr1_Conn2,r" means Node "Conn1" is created then relationship |
|
1692 # "IPCPr1_Conn2" is destroyed. It is possible to infer <type> from the presence of an "_" in the |
|
1693 # <name>, but this is considered too implicit and error prone to future modifications. |
|
1694 my $name; |
|
1695 my $first = 1; |
|
1696 foreach my $seq (@animateSequence) { |
|
1697 if (exists $seq->{object}) { |
|
1698 # animate/de-animate a node |
|
1699 if (hasRelationships($seq->{object})) { |
|
1700 DoComma(\$first); |
|
1701 print SVG qq{"$seq->{action},$seq->{object}{Name},n"}; # Rectangle & Text |
|
1702 } |
|
1703 } else { |
|
1704 # animate/de-animate a relationship between nodes |
|
1705 if (isRelated($seq->{srcObj}, $seq->{destObj})) { |
|
1706 DoComma(\$first); |
|
1707 print SVG qq{"$seq->{action},$seq->{name},r"}; # Line |
|
1708 } |
|
1709 } |
|
1710 } |
|
1711 AnimateSequencerPart2(); |
|
1712 |
|
1713 # output "animate.html" defining the animate control panel popup |
|
1714 outputAnimateHTML(); |
|
1715 } |
|
1716 |
|
1717 # tedium of ensuring that last entry in array doesn't have a trailing comma |
|
1718 sub DoComma($) |
|
1719 { |
|
1720 my $firstRef = $_[0]; |
|
1721 if ($$firstRef) { |
|
1722 $$firstRef = 0; |
|
1723 } else { |
|
1724 print SVG ",\n"; |
|
1725 } |
|
1726 } |
|
1727 |
|
1728 sub AnimatePrologue() |
|
1729 { |
|
1730 ########################### |
|
1731 # Begin Interpolated Text # |
|
1732 ########################### |
|
1733 print SVG<<END |
|
1734 |
|
1735 // TODO: |
|
1736 // - 0.8 opacity where required |
|
1737 |
|
1738 var sequenceIndex = 0; |
|
1739 |
|
1740 var firsttime = 1; |
|
1741 var animsMax = 2; |
|
1742 var anims = new Array(); |
|
1743 var animsNextFree = 0; |
|
1744 var eventListener = true; |
|
1745 |
|
1746 // The step period must be higher than the fade period ! |
|
1747 var animationStepPeriod = 500; |
|
1748 var animationFadePeriod = "0.2s"; |
|
1749 |
|
1750 var timerHandle; |
|
1751 var timerActive; |
|
1752 |
|
1753 var debugString = ""; |
|
1754 |
|
1755 var animationMode = false; |
|
1756 |
|
1757 function debug(string) |
|
1758 { |
|
1759 if (debugString.length > 100) { |
|
1760 debugString = ""; |
|
1761 } |
|
1762 debugString += string; |
|
1763 window.status = debugString; |
|
1764 } |
|
1765 |
|
1766 function initAnimate() |
|
1767 { |
|
1768 var i; |
|
1769 for (i = 0 ; i < animsMax ; ++i) { |
|
1770 anims[i] = new Object(); |
|
1771 anims[i].element = document.createElementNS("http://www.w3.org/2000/svg", "animate"); |
|
1772 anims[i].active = false; |
|
1773 with (anims[i].element) { |
|
1774 setAttribute("attributeName", "opacity"); |
|
1775 setAttribute("attributeType", "XML"); |
|
1776 setAttribute("begin", "indefinite"); |
|
1777 setAttribute("dur", animationFadePeriod); |
|
1778 setAttribute("fill", "freeze"); |
|
1779 if (eventListener) { |
|
1780 addEventListener("end", eventEnd, false); |
|
1781 } |
|
1782 } |
|
1783 } |
|
1784 |
|
1785 // HACK |
|
1786 // The first animation of each dynamically created SVG animate element doesn't seem to work (at least |
|
1787 // not in the Adobe SVG viewer), so we have to "kick start" them by performing dummy animate of an |
|
1788 // invisible rectangle. |
|
1789 |
|
1790 var svg = document.getElementById("svgroot"); |
|
1791 for (i = 0 ; i < animsMax ; ++i) { |
|
1792 var rect = document.createElementNS("http://www.w3.org/2000/svg", "rect"); |
|
1793 svg.appendChild(rect); |
|
1794 animateElement(rect, false); |
|
1795 } |
|
1796 } |
|
1797 |
|
1798 // Called when an animation element finishes its animation |
|
1799 function eventEnd(evt) |
|
1800 { |
|
1801 var animObj = findAnimateObjectByElement(evt.currentTarget); |
|
1802 if (animObj) { |
|
1803 releaseAnimateObject(animObj); |
|
1804 } else { |
|
1805 alert("eventEnd: cannot find associated animate object"); |
|
1806 } |
|
1807 } |
|
1808 |
|
1809 function startTimer() |
|
1810 { |
|
1811 timerHandle = setTimeout("animate(+1, true)", animationStepPeriod); |
|
1812 timerActive = true; |
|
1813 } |
|
1814 |
|
1815 function stopTimer() |
|
1816 { |
|
1817 if (timerActive) { |
|
1818 clearTimeout(timerHandle); |
|
1819 timerActive = false; |
|
1820 } |
|
1821 } |
|
1822 |
|
1823 function setAllVisibility(disposition) |
|
1824 { |
|
1825 setVisibility("rect", disposition); |
|
1826 setVisibility("line", disposition); |
|
1827 setVisibility("text", disposition); |
|
1828 setVisibility("g", disposition); |
|
1829 } |
|
1830 |
|
1831 function setVisibility(nodeName, disposition) |
|
1832 { |
|
1833 var els = document.getElementsByTagNameNS("http://www.w3.org/2000/svg", nodeName); |
|
1834 for (var i = 0 ; i < els.length ; ++i) { |
|
1835 var node = els.item(i); |
|
1836 // Only consider nodes with an id, as these represent the objects we are interested in - |
|
1837 // relationship lines between nodes, node rectangles and node textual names. This leaves |
|
1838 // the group highlight rectangles intact. |
|
1839 if (node.id) { |
|
1840 if (disposition) { |
|
1841 node.setAttribute("opacity", "1"); // what about 0.8?? |
|
1842 } else { |
|
1843 node.setAttribute("opacity", "0"); |
|
1844 } |
|
1845 } |
|
1846 } |
|
1847 } |
|
1848 |
|
1849 // |
|
1850 // Given an SVG animate element, find the associated anims[] entry that owns that element. |
|
1851 // |
|
1852 function findAnimateObjectByElement(element) |
|
1853 { |
|
1854 for (var i = 0 ; i < animsMax ; ++i) { |
|
1855 if (anims[i].element == element) { |
|
1856 return anims[i]; |
|
1857 } |
|
1858 } |
|
1859 } |
|
1860 |
|
1861 function grabAnimateObject() |
|
1862 { |
|
1863 if (animsNextFree < animsMax) { |
|
1864 releaseAnimateObject(anims[animsNextFree]); |
|
1865 |
|
1866 anims[animsNextFree].active = true; |
|
1867 return anims[animsNextFree++]; |
|
1868 } else { |
|
1869 return null; |
|
1870 } |
|
1871 } |
|
1872 |
|
1873 function releaseAnimateObject(animObject) |
|
1874 { |
|
1875 if (animObject.active) { |
|
1876 releaseAnimateElement(animObject.element); |
|
1877 animObject.active = false; |
|
1878 } |
|
1879 } |
|
1880 |
|
1881 function releaseAnimateElement(animElement) |
|
1882 { |
|
1883 var parent = animElement.parentNode; |
|
1884 if (parent) { |
|
1885 // Once an animate element has finished animating its parent element, we need to remove it as |
|
1886 // a child of that element to be re-used as a child of the next element to animate. However, removing |
|
1887 // it seems to reset the animated attribute of the parent back to its original pre-animated state. |
|
1888 // Consequently, we have to explicitly set the parent attribute to the target value after removing |
|
1889 // the child. |
|
1890 var opacity = animElement.getAttribute("to"); |
|
1891 parent.removeChild(animElement); |
|
1892 parent.setAttribute("opacity", opacity); |
|
1893 } |
|
1894 } |
|
1895 |
|
1896 // Once all animate elements have done their job, remove them from the parent nodes that they are animating |
|
1897 // so that they can be re-used. |
|
1898 function releaseAnimateObjects() |
|
1899 { |
|
1900 if (!eventListener) { |
|
1901 for (var i = 0 ; i < animsMax ; ++i) { |
|
1902 releaseAnimateObject(anims[i]); |
|
1903 } |
|
1904 } |
|
1905 animsNextFree = 0; |
|
1906 } |
|
1907 |
|
1908 function animateElement(elementToAnimate, action) |
|
1909 { |
|
1910 var from; |
|
1911 var to; |
|
1912 if (action) { |
|
1913 // Make visible |
|
1914 from = "0"; |
|
1915 to = "1"; // incomplete - need to go to 0.8 for rectangles |
|
1916 } else { |
|
1917 // Make invisible |
|
1918 from = "1"; // incomplete - need to go from 0.8 for rectangles |
|
1919 to = "0"; |
|
1920 } |
|
1921 var animObject = grabAnimateObject(); |
|
1922 var animElement = animObject.element; |
|
1923 animElement.setAttribute("from", from); |
|
1924 animElement.setAttribute("to", to); |
|
1925 elementToAnimate.appendChild(animElement); // make the animation element a child of the parent element to animate |
|
1926 animElement.beginElement(); // start animation |
|
1927 } |
|
1928 |
|
1929 function animate(direction, continuous) |
|
1930 { |
|
1931 // In an ideal world, the "end" animation event can be used to release the objects immediately |
|
1932 // their animations have finished. However, we do not seem to get "end" animate events at the end |
|
1933 // of the first animation of an animation element. |
|
1934 releaseAnimateObjects(); |
|
1935 |
|
1936 var extendedStatus = false; |
|
1937 if (direction == +1) { |
|
1938 if (sequenceIndex < sequences.length) { |
|
1939 var sequence = sequences[sequenceIndex]; |
|
1940 var fields = sequence.split(',', 3); |
|
1941 |
|
1942 animatePieces(fields, direction); |
|
1943 if (++sequenceIndex < sequences.length && continuous) { |
|
1944 startTimer(); |
|
1945 } |
|
1946 extendedStatus = true; |
|
1947 } |
|
1948 } else |
|
1949 if (direction == -1) { |
|
1950 if (sequenceIndex > 0) { |
|
1951 var sequence = sequences[--sequenceIndex]; |
|
1952 var fields = sequence.split(',', 3); |
|
1953 |
|
1954 animatePieces(fields, direction); |
|
1955 extendedStatus = true; |
|
1956 } |
|
1957 } |
|
1958 else |
|
1959 alert("Bad direction " + direction + " in animate()"); |
|
1960 |
|
1961 var text = sequenceIndex + " / " + (sequences.length - 1); |
|
1962 if (extendedStatus) { |
|
1963 text = FormStatusString(text, fields, direction); |
|
1964 } |
|
1965 SetStatusLine(text); |
|
1966 } |
|
1967 |
|
1968 function FormStatusString(prefix, fields, direction) |
|
1969 { |
|
1970 var text = prefix + ": "; |
|
1971 if (direction == -1) { |
|
1972 text += "! "; |
|
1973 } |
|
1974 if (fields[0] == "0") { |
|
1975 if (fields[2] == "n") { |
|
1976 text += "Destroy "; |
|
1977 } else { |
|
1978 text += "Unrelate "; |
|
1979 } |
|
1980 } else { |
|
1981 if (fields[2] == "n") { |
|
1982 text += "Create "; |
|
1983 } else { |
|
1984 text += "Relate "; |
|
1985 } |
|
1986 } |
|
1987 return text + fields[1]; |
|
1988 } |
|
1989 |
|
1990 function SetStatusLine(text) |
|
1991 { |
|
1992 window.status = text; |
|
1993 } |
|
1994 |
|
1995 function animatePieces(fields, direction) |
|
1996 { |
|
1997 var action = (fields[0] == "0") ? false : true; |
|
1998 if (direction == -1) { |
|
1999 action = !action; |
|
2000 } |
|
2001 var el; |
|
2002 if (fields[2] == "n") { |
|
2003 // Object to animate is a Node. Animate the rectangle and text. |
|
2004 el = document.getElementById(fields[1]); |
|
2005 animateElement(el, action); |
|
2006 |
|
2007 el = document.getElementById(fields[1] + "_t"); |
|
2008 animateElement(el, action); |
|
2009 } else { |
|
2010 // Object to animate is a Relationship between Nodes. Animate the line. |
|
2011 el = document.getElementById(fields[1]); |
|
2012 animateElement(el, action); |
|
2013 } |
|
2014 } |
|
2015 |
|
2016 |
|
2017 function setAnimationMode() |
|
2018 { |
|
2019 if (!animationMode) { |
|
2020 setAllVisibility(false); |
|
2021 animationMode = true; |
|
2022 } |
|
2023 } |
|
2024 |
|
2025 function resetAnimationMode() |
|
2026 { |
|
2027 if (animationMode) { |
|
2028 setAllVisibility(true); |
|
2029 animationMode = false; |
|
2030 sequenceIndex = 0; |
|
2031 } |
|
2032 } |
|
2033 |
|
2034 function animateCommand(cmd) |
|
2035 { |
|
2036 switch (cmd) { |
|
2037 case "p": // Play |
|
2038 setAnimationMode(); |
|
2039 startTimer(); |
|
2040 break; |
|
2041 case "rw": // Rewind |
|
2042 stopTimer(); |
|
2043 setAllVisibility(false); |
|
2044 animationMode = true; |
|
2045 sequenceIndex = 0; |
|
2046 break; |
|
2047 case "s": // Stop |
|
2048 stopTimer(); |
|
2049 releaseAnimateObjects(); |
|
2050 break; |
|
2051 case "+": // Step Forward |
|
2052 stopTimer(); |
|
2053 setAnimationMode(); |
|
2054 animate(+1, false); |
|
2055 break; |
|
2056 case "-": // Step Backward |
|
2057 stopTimer(); |
|
2058 setAnimationMode(); |
|
2059 animate(-1, false); |
|
2060 break; |
|
2061 case "rs": // Restore |
|
2062 stopTimer(); |
|
2063 resetAnimationMode(); |
|
2064 break; |
|
2065 default: |
|
2066 alert("animateCommand: Invalid command: " + cmd); |
|
2067 break; |
|
2068 } |
|
2069 } |
|
2070 END |
|
2071 ############################ |
|
2072 # ...End Interpolated Text # |
|
2073 ############################ |
|
2074 } |
|
2075 |
|
2076 sub AnimateSequencerPart1() |
|
2077 { |
|
2078 ############################## |
|
2079 # Begin Interpolated Text... # |
|
2080 ############################## |
|
2081 print SVG<<END |
|
2082 // sequences[] is an array of strings defining the animation sequence, where each string is of the form: |
|
2083 // "<action>,<name>,<type>" |
|
2084 // <action> = "0" for destroy, "1" for create |
|
2085 // <name> = name of node or relationship between nodes |
|
2086 // <type> = "0" if <name> refers to a node, "1" if a relationship between nodes |
|
2087 |
|
2088 var sequences = new Array( |
|
2089 END |
|
2090 ############################ |
|
2091 # ...End Interpolated Text # |
|
2092 ############################ |
|
2093 } |
|
2094 |
|
2095 sub AnimateSequencerPart2() |
|
2096 { |
|
2097 print SVG ");\n\n"; |
|
2098 } |