Overview
Comment:Handles repetitions (cmp.txt, ibg.m and abg.m)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | origin/master | trunk
Files: files | file ages | folders
SHA3-256: 8882cbd39e591500bcc97360fe794180a01f643c31e10a695c43da98447f0de4
User & Date: geraint@users.sourceforge.net on 2004-08-02 06:55:01
Other Links: branch diff | manifest | tags
Context
2004-08-02
09:33:25
Script to convert lbl.txt to cmp.m check-in: 487a38ee85 user: geraint@users.sourceforge.net tags: origin/master, trunk
06:55:01
Handles repetitions (cmp.txt, ibg.m and abg.m) check-in: 8882cbd39e user: geraint@users.sourceforge.net tags: origin/master, trunk
2004-08-01
22:07:14
Writes anonymous components (except junctions) to cmp.txt and then assigns names to them. check-in: a828e95287 user: geraint@users.sourceforge.net tags: origin/master, trunk
Changes

Modified mttroot/mtt/bin/trans/dia2abg.pl from [631b1db315] to [cf869a340e].

88
89
90
91
92
93
94


95
96
97
98
99
100
101
use XML::DOM;

my (%component_id_tag, %bond_id_start_id, %bond_id_end_id,
    %component_label_data, $objects, %mtt_bond_id_index,
    %bond_id_arrow_on_start, %bond_id_flow_causality, %bond_id_effort_causality,
    %bond_id_start_label,%bond_id_end_label);



# Parse user options:
my $diagram_name = '';
my $dia_input_file = '';
my $dia_output_file = '';
my $label_file = '';
my $component_list_file = '';
my $debug = 0;







>
>







88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
use XML::DOM;

my (%component_id_tag, %bond_id_start_id, %bond_id_end_id,
    %component_label_data, $objects, %mtt_bond_id_index,
    %bond_id_arrow_on_start, %bond_id_flow_causality, %bond_id_effort_causality,
    %bond_id_start_label,%bond_id_end_label);

my (%component_id_type, %component_id_name, %component_id_reps, %component_id_anon);

# Parse user options:
my $diagram_name = '';
my $dia_input_file = '';
my $dia_output_file = '';
my $label_file = '';
my $component_list_file = '';
my $debug = 0;
135
136
137
138
139
140
141

142
143
144
145
146
147
148
149
150
151
152
153
my $dom = new XML::DOM::Parser;
my ($doc);

$doc = $dom->parsefile($dia_input_file);
$objects = get_objects_node($doc,"Bond Graph");

get_component_data($objects);


get_bond_data($objects);

create_component_list() if ($create_component_list);
name_anonymous_components();

if ($create_abg) {
    open (OUT,">$abg_file") ||
	die "Cannot open $abg_file for writing.\n";

    # Don't update the label file unless we are creating component list and abg simultaneously...
    if ($create_component_list) {







>




<







137
138
139
140
141
142
143
144
145
146
147
148

149
150
151
152
153
154
155
my $dom = new XML::DOM::Parser;
my ($doc);

$doc = $dom->parsefile($dia_input_file);
$objects = get_objects_node($doc,"Bond Graph");

get_component_data($objects);
parse_component_data();

get_bond_data($objects);

create_component_list() if ($create_component_list);


if ($create_abg) {
    open (OUT,">$abg_file") ||
	die "Cannot open $abg_file for writing.\n";

    # Don't update the label file unless we are creating component list and abg simultaneously...
    if ($create_component_list) {
186
187
188
189
190
191
192

193



194
195
196
197
198
199
200
201
202
203
204
205
sub create_component_list {
    my ($type, $name);

    print_debug("CREATING unique_raw_list...\n");
    open (RAW,">$component_list_file") ||
	die "Cannot open $component_list_file for writing.\n";


    foreach my $val (values(%component_id_tag)) {	



	$_ = $val;
	id_cleaner();
	$val = $_;
	($type, $name) = split (/:/) ;
	$type = $type ? $type : $val;
	print RAW $val . "\n" if (($type ne "1") and ($type ne "0"));
    }
    close(RAW);
}


sub get_label_data {







>

>
>
>


|
<
<







188
189
190
191
192
193
194
195
196
197
198
199
200
201
202


203
204
205
206
207
208
209
sub create_component_list {
    my ($type, $name);

    print_debug("CREATING unique_raw_list...\n");
    open (RAW,">$component_list_file") ||
	die "Cannot open $component_list_file for writing.\n";

    my (%reverse_component_id_tag) = reverse (%component_id_tag);
    foreach my $val (values(%component_id_tag)) {	
	my ($id, $type);
	$id = $reverse_component_id_tag{$val};
	$type = $component_id_type{$id};
	$_ = $val;
	id_cleaner();
	$val =  $_;


	print RAW $val . "\n" if (($type ne "1") and ($type ne "0"));
    }
    close(RAW);
}


sub get_label_data {
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365

366
367
368
369
370
371
372
}

sub output_abg {
    my ($cr,$rep,$stat,$NM,$type,$arg,$bond_id,$start,$end,@clist,$connections,
	$strlength,$subsys_or_port);

    print_debug("WRITING OUTPUT TO STDIO...\n");
    $rep = "1";
    $stat = "-1";

    output_abg_header();
    
    foreach my $id (keys(%component_id_tag)) {
	($subsys_or_port,$_) = id_to_name($id);
	remove_brackets(); $NM = $_;

	$type = id_to_type($id);

	$cr = "" unless defined($cr = $component_label_data{$NM}[1]);
	$arg = "" unless defined($arg = $component_label_data{$NM}[2]);


	@clist = ();
	while (($bond_id,$start) = each(%bond_id_start_id)) {
	    push(@clist, ($bond_id_arrow_on_start{$bond_id} ? -1 : 1) *
		 $mtt_bond_id_index{$bond_id}) if $start eq $id;
	}
	while (($bond_id,$end) = each(%bond_id_end_id)) {







<








|



>







350
351
352
353
354
355
356

357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
}

sub output_abg {
    my ($cr,$rep,$stat,$NM,$type,$arg,$bond_id,$start,$end,@clist,$connections,
	$strlength,$subsys_or_port);

    print_debug("WRITING OUTPUT TO STDIO...\n");

    $stat = "-1";

    output_abg_header();
    
    foreach my $id (keys(%component_id_tag)) {
	($subsys_or_port,$_) = id_to_name($id);
	remove_brackets(); $NM = $_;

	$type = $component_id_type{$id};

	$cr = "" unless defined($cr = $component_label_data{$NM}[1]);
	$arg = "" unless defined($arg = $component_label_data{$NM}[2]);
	$rep = $component_id_reps{$id};

	@clist = ();
	while (($bond_id,$start) = each(%bond_id_start_id)) {
	    push(@clist, ($bond_id_arrow_on_start{$bond_id} ? -1 : 1) *
		 $mtt_bond_id_index{$bond_id}) if $start eq $id;
	}
	while (($bond_id,$end) = each(%bond_id_end_id)) {
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
	$head_label,$tail_label,
	$effort_causality,$flow_causality);

    output_ibg_header();

    %reverse_mtt_bond_id_index = reverse (%mtt_bond_id_index);

#    while (($mtt_bond_id, $dia_bond_id) = each(%reverse_mtt_bond_id_index)) {
    @bonds = (sort keys (%reverse_mtt_bond_id_index));
    foreach $mtt_bond_id (@bonds) {
 
	$dia_bond_id = $reverse_mtt_bond_id_index{$mtt_bond_id};

	$start = $bond_id_start_id{$dia_bond_id};
	$end   = $bond_id_end_id  {$dia_bond_id};







<







433
434
435
436
437
438
439

440
441
442
443
444
445
446
	$head_label,$tail_label,
	$effort_causality,$flow_causality);

    output_ibg_header();

    %reverse_mtt_bond_id_index = reverse (%mtt_bond_id_index);


    @bonds = (sort keys (%reverse_mtt_bond_id_index));
    foreach $mtt_bond_id (@bonds) {
 
	$dia_bond_id = $reverse_mtt_bond_id_index{$mtt_bond_id};

	$start = $bond_id_start_id{$dia_bond_id};
	$end   = $bond_id_end_id  {$dia_bond_id};
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
	if ($start_label !~  /\[.*\]/) {
	    $start_label = "[]";
	}
	if ($end_label !~ /\[.*\]/) {
	    $end_label = "[]";
	}

	# ignore label if it is not enclosed by []
#	$start_label =~ s/[^[]*\[\([^]]*\)\]/[$1]/;
#	$end_label   =~ s/[^[]*\[\([^]]*\)\]/[$1]/;

	if ($bond_id_arrow_on_start{$dia_bond_id}) {
	    $head_label = $end_label;
	    $tail_label = $start_label;
	} else {
	    $head_label = $start_label;
	    $tail_label = $end_label;
	}

	$head_component = $component_id_tag{$head};
	$tail_component = $component_id_tag{$tail};

	$effort_causality = $bond_id_effort_causality{$dia_bond_id};
	$flow_causality   = $bond_id_flow_causality  {$dia_bond_id};

	for ($effort_causality) {
	    if (/-1/) { $effort_causality = "tail";}
	    if (/0/) { $effort_causality = "none";}







<
<
<
<








|
|







460
461
462
463
464
465
466




467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
	if ($start_label !~  /\[.*\]/) {
	    $start_label = "[]";
	}
	if ($end_label !~ /\[.*\]/) {
	    $end_label = "[]";
	}





	if ($bond_id_arrow_on_start{$dia_bond_id}) {
	    $head_label = $end_label;
	    $tail_label = $start_label;
	} else {
	    $head_label = $start_label;
	    $tail_label = $end_label;
	}

	$head_component = "$component_id_type{$head}:$component_id_name{$head}";
	$tail_component = "$component_id_type{$tail}:$component_id_name{$tail}";

	$effort_causality = $bond_id_effort_causality{$dia_bond_id};
	$flow_causality   = $bond_id_flow_causality  {$dia_bond_id};

	for ($effort_causality) {
	    if (/-1/) { $effort_causality = "tail";}
	    if (/0/) { $effort_causality = "none";}
549
550
551
552
553
554
555
556
557
558
559
560
561
562





563
564

565

566


567
568



569
570
571
572
573
574
575
576
      $str_elem = get_first_element_subnode($strattr);
      $string = get_first_text_subnode($str_elem);
      $component_id_tag{$id} = $string->getData;
  }
    die "There are no components!\n" unless keys(%component_id_tag) > 0;
}

sub name_anonymous_components {
    my ($id, $component, $type, $name, $anon_id);
    $anon_id = 0;
    while (($id, $component) = each(%component_id_tag)) {
	$_ = $component;
	id_cleaner();
	$component = $_;





	($type, $name) = split (/:/, $component);
	if (! $name) {

	    $component = "${component}:mtt${component}_${anon_id}";

	    $anon_id++;


	}
	$component_id_tag{$id} = $component;



    }    
}

# Dia stores its attributes in a strange way, not using typical xml attributes.
sub get_dia_attribute_value {
    my ($type, $attribute_node )= @_;
    my ($subnode);
    $subnode = get_first_subnode_by_nodename_attribute(0,$attribute_node,$type);







|
|
|
|



>
>
>
>
>
|

>
|
>
|
>
>

|
>
>
>
|







548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
      $str_elem = get_first_element_subnode($strattr);
      $string = get_first_text_subnode($str_elem);
      $component_id_tag{$id} = $string->getData;
  }
    die "There are no components!\n" unless keys(%component_id_tag) > 0;
}

sub parse_component_data {
    my ($anon_index, $id, $component, $anonymous);
    $anon_index = 0;
    while (($id, $component) = each (%component_id_tag)) {
	$_ = $component;
	id_cleaner();
	$component = $_;
	my ($type_name, $repetitions) = split (/\*/, $component);
	if (! $repetitions) {
	    $type_name = $component;
	    $repetitions = 1;
	}
	my ($type, $name) = split (/:/, $type_name);
	if (! $name) {
	    $type = $type_name;
	    $name = "mtt${type}_${anon_index}";
	    $anonymous = 1;
	    $anon_index++;
	} else {
	    $anonymous = 0;
	}
	$component_id_type{$id} = $type;
	$component_id_name{$id} = $name;
	$component_id_reps{$id} = $repetitions;
	$component_id_anon{$id} = $anonymous;
    }
}

# Dia stores its attributes in a strange way, not using typical xml attributes.
sub get_dia_attribute_value {
    my ($type, $attribute_node )= @_;
    my ($subnode);
    $subnode = get_first_subnode_by_nodename_attribute(0,$attribute_node,$type);
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
    s/#?([^#]*)#?/$1/;
}

sub remove_brackets {
    s/^\[([^\]]*)\]$/$1/;
}

sub id_to_type {
    my ( $id )= @_;
    my($type,$name);

    $_ = $component_id_tag{$id};
    id_cleaner();
    ($type, $name) = split(/:/);

    return $type;
}

# If 1 LHS argument is used, it returns component name.  If 2 are used, it return
# "subsystem" or "port" depending on whether brackets are found in the name.
sub id_to_name {
    my ( $id )= @_;
    my($type,$name);

    $_ = $component_id_tag{$id};
    id_cleaner();
    ($type, $name) = split(/:/);

    if(!defined($name)) { $name = $id };

    return ( ($name =~ /^\[[^\]]*\]$/ ? "ports" : "subsystems" ),$name);
}

sub print_debug {







<
<
<
<
<
<
<
<
<
<
<





|
|
<
|







753
754
755
756
757
758
759











760
761
762
763
764
765
766

767
768
769
770
771
772
773
774
    s/#?([^#]*)#?/$1/;
}

sub remove_brackets {
    s/^\[([^\]]*)\]$/$1/;
}












# If 1 LHS argument is used, it returns component name.  If 2 are used, it return
# "subsystem" or "port" depending on whether brackets are found in the name.
sub id_to_name {
    my ( $id )= @_;
    my($type,$name);
    
    $type = $component_id_type{$id};

    $name = $component_id_name{$id};

    if(!defined($name)) { $name = $id };

    return ( ($name =~ /^\[[^\]]*\]$/ ? "ports" : "subsystems" ),$name);
}

sub print_debug {


MTT: Model Transformation Tools
GitHub | SourceHut | Sourceforge | Fossil RSS ]