Differences From Artifact [e68e309d17]:

To Artifact [d84745ea9f]:


89
90
91
92
93
94
95

96
97
98
99
100
101
102

103
104
105
106
107
108
109

110
111
112
113
114
115
116
117
118
119
120
121
122
123



124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
my $diagram_name = '';
my $dia_file = '';
my $label_file = '';
my $component_list_file = '';
my $debug = 0;
my $create_component_list = 0;
my $create_abg = 0;

GetOptions ('diagram_name=s' => \$diagram_name,
	    'dia_file=s' => \$dia_file,
	    'label_file=s' => \$label_file,
	    'component_list_file=s' => \$component_list_file,
	    'debug' => \$debug,
	    'create_component_list' => \$create_component_list,
	    'create_abg' => \$create_abg,

	    );

die usage() if $diagram_name eq '';

# Use defaults if necessary:
$dia_file = $diagram_name . "_abg.dia" if ($dia_file eq '');
$label_file = $diagram_name . "_lbl.txt" if ($label_file eq '');

$component_list_file = $diagram_name . "_cmp.txt" if ($component_list_file eq '');

# Start Parsing XML, and creating files:
my $dom = new XML::DOM::Parser;
my ($doc);

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

get_component_data($objects);
get_bond_data($objects);

create_component_list() if ($create_component_list);
if ($create_abg) {



    # Don't update the label file unless we are creating component list and abg simultaneously...
    if ($create_component_list) {
	#system("abg2lbl_fig2txt -c $component_list_file $diagram_name") &&
	system("abg2lbl_fig2txt -x $diagram_name") &&
	    die "abg2lbl_fig2txt failed.";
    }

    get_label_data();
    output_abg();
    output_bond_causality();
    parse_aliases();
    print "endfunction\n";
}


#print $doc->toString;

exit 0;








>







>







>














>
>
>











|







89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
my $diagram_name = '';
my $dia_file = '';
my $label_file = '';
my $component_list_file = '';
my $debug = 0;
my $create_component_list = 0;
my $create_abg = 0;
my $abg_file = '';
GetOptions ('diagram_name=s' => \$diagram_name,
	    'dia_file=s' => \$dia_file,
	    'label_file=s' => \$label_file,
	    'component_list_file=s' => \$component_list_file,
	    'debug' => \$debug,
	    'create_component_list' => \$create_component_list,
	    'create_abg' => \$create_abg,
	    'abg_file=s' => \$abg_file,
	    );

die usage() if $diagram_name eq '';

# Use defaults if necessary:
$dia_file = $diagram_name . "_abg.dia" if ($dia_file eq '');
$label_file = $diagram_name . "_lbl.txt" if ($label_file eq '');
$abg_file = $diagram_name . "_abg.m" if ($abg_file eq '');
$component_list_file = $diagram_name . "_cmp.txt" if ($component_list_file eq '');

# Start Parsing XML, and creating files:
my $dom = new XML::DOM::Parser;
my ($doc);

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

get_component_data($objects);
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) {
	#system("abg2lbl_fig2txt -c $component_list_file $diagram_name") &&
	system("abg2lbl_fig2txt -x $diagram_name") &&
	    die "abg2lbl_fig2txt failed.";
    }

    get_label_data();
    output_abg();
    output_bond_causality();
    parse_aliases();
    print OUT "endfunction\n";
}


#print $doc->toString;

exit 0;

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
  }
    close(LBL);
}

sub parse_aliases {
    my ($name,@line,$alias);

    print "# Aliases\n";
    print "# A double underscore __ represents a comma\n";

    open (LBL,$label_file) || die "Cannot open label file: $label_file\n";

    while (<LBL>) {
      chomp;
      # Get rid of everything except ALIAS lines:
      next unless (s/^[%\#]ALIAS(.*)$/$1/);
      # Get rid of leading/trailing whitespace:
      s/^\s*(\S.+\S)\s*$/$1/;

      @line = split(/\s+/);
      die "Label file ALIAS entries must have 2 columns!\n" unless
	  @line == 2;

      print "$diagram_name.alias.$line[1] = \"$line[0]\";\n";
  }
    close(LBL);
    print "## Port domain and units\n";
    print "## Explicit variable declarations\n";
}

sub get_objects_node {
    my ( $doc_node, $layer_name )= @_;
    my ($root,$layer_node,$objects);

    $root = get_first_element_subnode($doc_node);







|
|














|


|
|







190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
  }
    close(LBL);
}

sub parse_aliases {
    my ($name,@line,$alias);

    print OUT "# Aliases\n";
    print OUT "# A double underscore __ represents a comma\n";

    open (LBL,$label_file) || die "Cannot open label file: $label_file\n";

    while (<LBL>) {
      chomp;
      # Get rid of everything except ALIAS lines:
      next unless (s/^[%\#]ALIAS(.*)$/$1/);
      # Get rid of leading/trailing whitespace:
      s/^\s*(\S.+\S)\s*$/$1/;

      @line = split(/\s+/);
      die "Label file ALIAS entries must have 2 columns!\n" unless
	  @line == 2;

      print OUT "$diagram_name.alias.$line[1] = \"$line[0]\";\n";
  }
    close(LBL);
    print OUT "## Port domain and units\n";
    print OUT "## Explicit variable declarations\n";
}

sub get_objects_node {
    my ( $doc_node, $layer_name )= @_;
    my ($root,$layer_node,$objects);

    $root = get_first_element_subnode($doc_node);
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
    return 0;
}

sub output_abg_header {
    my ($date);
    $date = `date`; chomp($date);

    print <<"EOF";
function [${diagram_name}] =  ${diagram_name}_abg
# This function is the acausal bond graph representation of $diagram_name
# Generated by dia2abg.pl on $date
# The file is in Octave format

# Subsystems and Ports

EOF
}

sub output_component {
    my ($NM,$type,$cr,$arg,$rep,$stat,$connections) = @_;

	print <<"EOF";
# Component $NM
  $diagram_name.subsystems.$NM.type = "$type";
  $diagram_name.subsystems.$NM.cr = "$cr";
  $diagram_name.subsystems.$NM.arg = "$arg";
  $diagram_name.subsystems.$NM.repetitions = $rep;
  $diagram_name.subsystems.$NM.status = $stat;
  $diagram_name.subsystems.$NM.connections = [$connections];







|













|







270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
    return 0;
}

sub output_abg_header {
    my ($date);
    $date = `date`; chomp($date);

    print OUT <<"EOF";
function [${diagram_name}] =  ${diagram_name}_abg
# This function is the acausal bond graph representation of $diagram_name
# Generated by dia2abg.pl on $date
# The file is in Octave format

# Subsystems and Ports

EOF
}

sub output_component {
    my ($NM,$type,$cr,$arg,$rep,$stat,$connections) = @_;

	print OUT <<"EOF";
# Component $NM
  $diagram_name.subsystems.$NM.type = "$type";
  $diagram_name.subsystems.$NM.cr = "$cr";
  $diagram_name.subsystems.$NM.arg = "$arg";
  $diagram_name.subsystems.$NM.repetitions = $rep;
  $diagram_name.subsystems.$NM.status = $stat;
  $diagram_name.subsystems.$NM.connections = [$connections];
335
336
337
338
339
340
341
342
343
344
345
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
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391

	}
	$connections = join(" ",@clist);

	output_component($NM,$type,$cr,$arg,$rep,$stat,$connections);
    }
    
    print "# Ordered list of subsystem names\n";
    # order component id's so that entries found in _lbl.txt file are
    # in _lbl file order, and other entries follow.
    my (@id_list);
    @id_list = keys(%component_id_tag);
    @id_list = sort by_label_file @id_list;

    # calculate string length of longest component name (for octave):
    $strlength=0;
    foreach my $compname (@id_list) {
	my $name = id_to_name($compname);
	$strlength = length($name) if length($name) > $strlength;
    };

    my $i=1;
    foreach my $id (@id_list) {
	my $name = id_to_name($id);
	print "  " . $diagram_name . ".subsystemlist($i,:)" . ' = "'
	    . $name . " " x ($strlength - length($name)) . '";' . "\n";
	$i++;
    }
    print "\n";
}

sub output_bond_causality {
    my ($mtt_bond_id,$dia_bond_id,$mtt_causality,%reverse_mtt_bond_id_index);

    print "# Bonds\n";
    print "  $diagram_name.bonds = [\n";

    %reverse_mtt_bond_id_index = reverse(%mtt_bond_id_index);

    while (($mtt_bond_id,$dia_bond_id) = each(%reverse_mtt_bond_id_index)) {

	#print "mtt: $mtt_bond_id\n";
	#print "dia: $dia_bond_id\n";

	$mtt_causality =
	    get_sign_of_power($dia_bond_id) * get_sign_of_causality($dia_bond_id);

	print "      $mtt_causality $mtt_causality\n";
    }
    print "      ];\n\n";
}

sub get_component_data {
    my ( $objects_node )= @_;
    my($obj,$id,$attr,$comp,$strattr,$str_elem,$string);

    print_debug("READING COMPONENTS FROM $dia_file...\n");







|
















|



|





|
|




<
<
<
<



|

|







341
342
343
344
345
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
373
374
375
376
377
378
379
380




381
382
383
384
385
386
387
388
389
390
391
392
393

	}
	$connections = join(" ",@clist);

	output_component($NM,$type,$cr,$arg,$rep,$stat,$connections);
    }
    
    print OUT "# Ordered list of subsystem names\n";
    # order component id's so that entries found in _lbl.txt file are
    # in _lbl file order, and other entries follow.
    my (@id_list);
    @id_list = keys(%component_id_tag);
    @id_list = sort by_label_file @id_list;

    # calculate string length of longest component name (for octave):
    $strlength=0;
    foreach my $compname (@id_list) {
	my $name = id_to_name($compname);
	$strlength = length($name) if length($name) > $strlength;
    };

    my $i=1;
    foreach my $id (@id_list) {
	my $name = id_to_name($id);
	print OUT "  " . $diagram_name . ".subsystemlist($i,:)" . ' = "'
	    . $name . " " x ($strlength - length($name)) . '";' . "\n";
	$i++;
    }
    print OUT "\n";
}

sub output_bond_causality {
    my ($mtt_bond_id,$dia_bond_id,$mtt_causality,%reverse_mtt_bond_id_index);

    print OUT "# Bonds\n";
    print OUT "  $diagram_name.bonds = [\n";

    %reverse_mtt_bond_id_index = reverse(%mtt_bond_id_index);

    while (($mtt_bond_id,$dia_bond_id) = each(%reverse_mtt_bond_id_index)) {




	$mtt_causality =
	    get_sign_of_power($dia_bond_id) * get_sign_of_causality($dia_bond_id);

	print OUT "      $mtt_causality $mtt_causality\n";
    }
    print OUT "      ];\n\n";
}

sub get_component_data {
    my ( $objects_node )= @_;
    my($obj,$id,$attr,$comp,$strattr,$str_elem,$string);

    print_debug("READING COMPONENTS FROM $dia_file...\n");
575
576
577
578
579
580
581

582
583
584
585
586
587
588
589
590

591
592
}

sub print_debug {
    print STDERR $_[0] if ($debug);
}

sub usage {

    print STDERR "\n";
    print STDERR "Usage: dia2abg.pl --diagram_name <diagram_name> [options]\n";
    print STDERR "Options:\n";
    print STDERR "\t--dia_file <dia_file>\n";
    print STDERR "\t--label_file <label_file>\n";
    print STDERR "\t--component_list_file\n";
    print STDERR "\t--create_component_list\n";
    print STDERR "\t--create_abg\n";
    print STDERR "\t--debug\n";

    print STDERR "\n";
}







>
|
|
|
|
|
|
|
|
|
>
|

577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
}

sub print_debug {
    print STDERR $_[0] if ($debug);
}

sub usage {
    return 
	"\n" .
	"Usage: dia2abg.pl --diagram_name <diagram_name> [options]\n" .
	"Options:\n" .
	"\t--dia_file <dia_file>\n" .
	"\t--label_file <label_file>\n" .
	"\t--component_list_file\n" .
	"\t--create_component_list\n" .
	"\t--create_abg\n" .
	"\t--debug\n" .
	"\t--abg_file <abg_file>\n" .
	"\n"
}

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