• R/O
  • SSH
  • HTTPS

make-flowchart: Commit


Commit MetaInfo

Revisão3 (tree)
Hora2009-03-22 06:14:50
Autortenmyo

Mensagem de Log

#15680 [修正]表示整形(流れを見やすく)

Mudança Sumário

Diff

--- trunk/fcml2dot.pl (revision 2)
+++ trunk/fcml2dot.pl (revision 3)
@@ -7,12 +7,13 @@
77
88 # フローチャートの要素データ(参照)リスト
99 # 要素内容は以下(将来的にはClass::Struct化したい)
10-#{
11-# ID => ユニークな識別子(コマンド_行番号),
12-# command => コマンド種別,
13-# args => コマンド引数,
14-# ref => 参照元IDのリスト(参照)@refIDs,
15-#}
10+# ID => {
11+# ID => ユニークな識別子(コマンド_行番号),
12+# command => コマンド種別,
13+# args => コマンド引数,
14+# ref => 参照元ID等のリスト(参照)@refIDs,
15+# level => 深さ,
16+# }
1617 my %nodelist;
1718
1819 # @nodelist->{ref}用の参照元データ(参照)リスト
@@ -46,12 +47,6 @@
4647 # コメント行はスキップ
4748 next if /^#/;
4849
49- # case case(非フローチャート要素)
50- /^case$/ && do {
51- # 次の要素の参照元にswitch,case引数を追加し、次行へ
52- @refIDs=([$switchstack[-1], $args]);
53- last;
54- };
5550 # case break(非フローチャート要素)
5651 /^break$/ && do {
5752 push @breakstack, $refIDs[-1];
@@ -113,6 +108,12 @@
113108 push @returnlist, [$currentID, $args];
114109 $command = "goto";
115110 };
111+ # case case
112+ /^case$/ && do {
113+ @refIDs=([$switchstack[-1], $args]);
114+ $args = $currentID;
115+ $command = "label";
116+ };
116117
117118 # default(全フローチャート要素)
118119 do {
@@ -121,6 +122,7 @@
121122 command => $command,
122123 args => $args,
123124 ref => [@refIDs],
125+ level => scalar @switchstack,
124126 };
125127 @refIDs=([$currentID, ""]);
126128 };
@@ -143,7 +145,7 @@
143145 # default node
144146 push @ret,
145147 qq/# default\n/,
146- qq/edge[labeldistance=1.5]\n/,
148+ qq/edge[labeldistance=1.5,tailport=s,headport=n];\n/,
147149 qq/node[height=0.2, width=1];\n/;
148150 push @ret, "\n";
149151
@@ -153,7 +155,7 @@
153155 qq/node[shape="diamond", style=""];\n/;
154156 foreach my $i (grep {$_->{command} eq "switch"} values(%$nodelist)) {
155157 push @ret,
156- qq/$i->{ID}\[label="$i->{args}"\];\n/;
158+ qq/$i->{ID}\[label="$i->{args}", group="$i->{level}"\];\n/;
157159 }
158160 push @ret, "\n";
159161
@@ -163,7 +165,7 @@
163165 qq/node[shape="rect", style=""];\n/;
164166 foreach my $i (grep {$_->{command} eq "do"} values(%$nodelist)) {
165167 push @ret,
166- qq/$i->{ID}\[label="$i->{args}"\];\n/;
168+ qq/$i->{ID}\[label="$i->{args}", group="$i->{level}"\];\n/;
167169 }
168170 push @ret, "\n";
169171
@@ -173,7 +175,7 @@
173175 qq/node[shape="record", style=""];\n/;
174176 foreach my $i (grep {$_->{command} eq "call"} values(%$nodelist)) {
175177 push @ret,
176- qq/$i->{ID}\[label="\\ |$i->{args}|\\ "\];\n/;
178+ qq/$i->{ID}\[label="\\ |$i->{args}|\\ ", group="$i->{level}"\];\n/;
177179 }
178180 push @ret, "\n";
179181
@@ -183,7 +185,7 @@
183185 qq/node[shape="rect", style="rounded"];\n/;
184186 foreach my $i (grep {$_->{command} eq "start_end"} values(%$nodelist)) {
185187 push @ret,
186- qq/$i->{ID}\[label="$i->{args}"\];\n/;
188+ qq/$i->{ID}\[label="$i->{args}", group="$i->{level}"\];\n/;
187189 }
188190 push @ret, "\n";
189191
@@ -193,10 +195,20 @@
193195 qq/node[shape="point", height=0, width=0];\n/;
194196 foreach my $i (grep {$_->{command} eq "goto"} values(%$nodelist)) {
195197 push @ret,
196- qq/$i->{ID};\n/;
198+ qq/$i->{ID}\[group="$i->{level}"\];\n/;
197199 }
198200 push @ret, "\n";
199201
202+ # label
203+ push @ret,
204+ qq/# label\n/,
205+ qq/node[shape="point", height=0, width=0];\n/;
206+ foreach my $i (grep {$_->{command} eq "label"} values(%$nodelist)) {
207+ push @ret,
208+ qq/$i->{ID}\[group="$i->{level}"\];\n/;
209+ }
210+ push @ret, "\n";
211+
200212 # edge
201213 foreach my $i (values(%$nodelist)) {
202214 foreach my $ref (@{$i->{ref}}) {
@@ -204,7 +216,7 @@
204216 qq/$ref->[0] -> $i->{ID}/;
205217
206218 push @ret,
207- qq/[taillabel="$ref->[1]"]/
219+ qq/[label="$ref->[1]"]/
208220 if $ref->[1];
209221
210222 if ((@{$i->{ref}} == 1) && ($i->{command} eq "goto")) {
@@ -211,12 +223,49 @@
211223 push @ret,
212224 qq/[arrowhead="none"]/;
213225 }
226+ if (($nodelist->{$ref->[0]}{command} ne "goto") && ($i->{command} eq "label")) {
227+ push @ret,
228+ qq/[arrowhead="none"]/;
229+ }
230+ if (($nodelist->{$ref->[0]}{command} eq "goto") && (not $ref->[1])) {
231+ push @ret,
232+ qq/[headport=e, constraint=false]/;
233+ }
214234
215235 push @ret, ";\n";
216236 }
217237 }
238+ push @ret, "\n";
218239
240+ # rank
241+ foreach my $i (grep {$_->{command} eq "switch"} values(%$nodelist)) {
242+ my @temp;
243+ push @ret,
244+ qq/{rank=same;/;
245+ foreach my $j (values(%$nodelist)) {
246+ next if not @{$j->{ref}};
247+ if (grep {$_ eq $i->{ID}} map {$_->[0]} @{$j->{ref}}) {
248+ push @ret,
249+ qq/$j->{ID};/;
250+
251+ foreach my $k (values(%$nodelist)) {
252+ next if @{$k->{ref}} != 1;
253+ push @temp,
254+ qq/$k->{ID}/
255+ if grep {$_ eq $j->{ID}} map {$_->[0]} @{$k->{ref}};
256+ }
257+ }
258+ }
259+ push @ret,
260+ qq/}\n/;
261+ push @ret,
262+ qq/{rank=same;/,
263+ join(";", @temp),
264+ qq/}\n/;
265+ }
266+ push @ret, "\n";
219267
268+
220269 return \@ret;
221270 }
222271
Show on old repository browser