#! /usr/bin/perl -w

### lbl2cmp_txt2m
## Creates _cmp.m from _lbl.txt
## Copyright (C) 2004 by Geraint Paul Bevan

  ###################################### 
  ##### Model Transformation Tools #####
  ######################################

use strict;
use diagnostics;
use Getopt::Long;

sub usage;
sub read_cmp_file;
sub read_cmp_line;
sub name_anonymous_component;
sub port_or_component;
sub read_lbl_file;
sub read_lbl_line;
sub write_header;
sub write_body;
sub strip_rubbish;

## fields to write to cmp.m
my (@component_name,
    %component_type,    
    %component_cr,
    %component_arg,
    %component_rep);

my $sys = '';

GetOptions ('sys=s' => \$sys);

die usage() if ($sys eq '');

## files to read/write
my $lbl = "${sys}_lbl.txt";
my $cmp = "${sys}_cmp.txt";
my $out = "${sys}_cmp.m";

## other global variables
my (%anonymous_component_type_index);

my $debug = 1;

read_cmp_file();
read_lbl_file();

write_header();
write_body();


sub usage() {
    return "Usage: lbl2cmp_txt2m --sys=<sys>\n";
}

sub read_cmp_file() {
    my ($line, $name, $type, $type_rep, $name_rep, $rep, $i, %anon_index);


    my (@c_name, %c_type, %c_rep, $i_c);

    my (@p_name, %p_type, %p_rep, $i_p);









    $i_c = 0;



    $i_p = 0;





















    open (CMP, $cmp) or die ("MTT: lbl2cmp_txt2m, cannot open $cmp");
    

    while (<CMP>) {
	
	chomp;
	# skip blank lines
	next if (/^(\s)*$/);
	# skip comments
	next if (/^(\s)*[%\#]/);
	# remove leading and trailing whitespace
	s/^\s*(\S.*\S)\s*$/$1/;
	
	$line = $_;
	print "read_cmp_file: line='${line}'\n" if defined ($debug);









	($type, $name, $rep) = read_cmp_line($line);

	$name = name_anonymous_component($type) if ($name eq '');
	
	if (port_or_component ($type, $name) eq "port") {
	    $i_p++;
	    $p_name[$i_p]  = $name;
	    $p_type{$name} = $type;
	    $p_rep{$name}  = $rep;
	} else {






	    $i_c++;

	    $c_name[$i_c]  = $name;


	    $c_type{$name} = $type;
	    $c_rep {$name} = $rep;
	}



    }
    close (CMP);

    $i = 0;
    while ($i < $i_p) {
	$i++;
	$name = $p_name[$i];
	$component_name[$i] = $name;
	$component_type{$name} = $p_type{$name};
	$component_rep {$name} = $p_rep{$name};
	$component_cr  {$name} = '';
	$component_arg {$name} = '';
    }
    while ($i < ($i_p + $i_c)) {
	$i++;
	$name = $c_name[${i}-${i_p}];
	$component_name[$i] = $name;
	$component_type{$name} = $c_type{$name};
	$component_rep {$name} = $c_rep{$name};
	$component_cr  {$name} = '';
	$component_arg {$name} = '';
    }
}

sub read_cmp_line() {
    my $line = $_;
    my ($type, $name, $rep, $misc);
    
    ($type, $misc) = split (/:/, $line);
    $type = $line unless defined ($type);

    if (defined ($misc)) {
	($name, $rep) = split (/\*/, $misc);
	$name = $misc unless defined ($name);
    }

    $name = '' unless defined $name;
    $rep  = 1  unless defined $rep;
    
    print "read_cmp_line: type='$type', name='$name', rep='$rep'\n" if defined ($debug);
    return ($type, $name, $rep);
}

sub name_anonymous_component() {
    my $type = @_;
    my ($name, $num);
    if (defined ($anonymous_component_type_index{$type})) {
	$anonymous_component_type_index{$type}++;
    } else {
	$anonymous_component_type_index{$type} = 0;
    }
    $num  = $anonymous_component_type_index{$type};
    $name = "mtt${type}_${num}";
    print "name_anonymous_component: type='${type}', name='${name}'\n" if defined ($debug);
    return ($name);
}

sub port_or_component() {
    my ($type, $name) = @_;
    my $retval;
    if ($type ne "SS") {
	$retval = "component";
    } else {
	print "port_or_component: name='${name}'\n";
	$_ = $name;
	if (/\[.+\]/) {
	    $retval = "port";
	} else {
	    $retval = "component";
	}
    }
    print "port_or_component: type='$type', name='$name' class='$retval'\n" if defined ($debug);
    return ($retval);
}

sub read_lbl_file() {
    my (@line, $name, $type, $cr, $arg, $i);
    
    open (LBL, $lbl) or die ("MTT: lbl2cmp_txt2m, cannot open $lbl");
    
    while (<LBL>) {
	
	chomp;
	# skip blank lines
	next if (/^(\s)*$/);
	# skip comments
	next if (/^(\s)*[%\#]/);
	# remove leading and trailing whitespace
	s/^\s*(\S.*\S)\s*$/$1/;
	
	($name, $cr, $arg) = read_lbl_line (@line);
	
	$component_cr{$name}  = $cr;
	$component_arg{$name} = $arg;
    }

    close (LBL);
}

sub read_lbl_line() {
    my @line = @_;
    my ($name, $cr, $arg);

    @line = split (/\s+/);
    $name = shift (@line);

    # strip repetitions (if any)
    $name =~ s/([^\*]*)\*.*/$1/;

    $cr  = shift (@line);
    $arg = shift (@line);

    $cr   = '' unless defined ($cr);
    $arg  = '' unless defined ($arg);
    
    print "read_lbl_line: name='$name' cr='$cr' arg='$arg'\n" if defined ($debug);
    return ($name, $cr, $arg);
}

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

    open (OUT, ">$out") or
	die "MTT: cannot open $out for writing.\n";
    
    print OUT << "EOF";
## $out -*-octave-*-
## Generated by MTT on $date

    
function [comp_type, name, cr, arg, repetitions] = ${sys}_cmp(i)

EOF

    close (OUT);
}

sub write_body() {
    my ($name, $i);

    open (OUT, ">>$out") or
	die "MTT: cannot open $out for writing.\n";

    $i = 0;
    foreach $name (@component_name) {
	if (defined ($name)) {
	    $i++;

	    print OUT
		"if (i == $i)\n" .
		"\tcomp_type   = '$component_type{$name}';\n" .
		"\tname        = '$name'\n" .
		"\tcr          = '$component_cr{$name}';\n" .
		"\targ         = '$component_arg{$name}';\n" .
		"\trepetitions =  $component_rep{$name} ;\n" .
		"end\n";
	}
    }

    close (OUT);
}