#!/bin/sh
     ###################################### 
     ##### Model Transformation Tools #####
     ######################################

# Bourne shell script: mtt_header
# Headings for functions
# Copyright (C) 2000 by Peter J. Gawthrop

###############################################################
## Version control history
###############################################################
## $Id$
## $Log$
## Revision 1.18  2000/12/03 16:06:22  peterg
## Fixed bug in generating dummies
## Added logic declarations
##
## Revision 1.17  2000/12/01 20:55:01  peterg
## Added Geraint's fix for zeroing matrices
##
## Revision 1.16  2000/12/01 17:56:30  peterg
## Removed spurious  echo '## Set matrices to zero' - thanks Geraint
##
## Revision 1.15  2000/11/29 21:06:16  peterg
## Removed Npar creation - not needed??
##
## Revision 1.14  2000/11/27 11:51:43  peterg
## Added zero matrices in matlab code
##
## Revision 1.13  2000/11/09 17:19:52  peterg
## Geraint's pow() mods
##
## Revision 1.12  2000/11/09 16:09:46  peterg
## Declare dummy variables (mtt_s1 etc)
##
## Revision 1.11  2000/11/09 15:29:35  peterg
## lower-case declarations
##
## Revision 1.10  2000/11/07 17:20:51  peterg
## useful-functions.hh now included locally
##
## Revision 1.9  2000/11/07 16:56:24  peterg
## Version from Geraint
##
## Revision 1.2  2000/11/03 00:55:42  geraint
## typo: missed out 'd' in mttedx
## todo: need to accommodate mttsimpar
##
## Revision 1.1  2000/11/02 04:28:39  geraint
## Initial revision
##
## Revision 1.8  2000/10/17 16:35:03  peterg
## No parameter,state or input conversion in txt files
##
## Revision 1.7  2000/10/17 09:53:20  peterg
## Fixed logic rep
##
## Revision 1.6  2000/10/17 08:37:23  peterg
## Included logic rep
##
## Revision 1.5  2000/10/14 09:12:14  peterg
## No dies arguments and output itself
##
## Revision 1.4  2000/10/14 06:49:31  peterg
## Make parameter listing representation dependent
##
## Revision 1.3  2000/10/11 08:59:15  peterg
## Added csex rep
##
## Revision 1.2  2000/10/11 08:01:42  peterg
## Added noglobal fudge
##
## Revision 1.1  2000/10/10 21:02:27  peterg
## Initial revision
##
###############################################################

# Arguments
system=$1
rep=$2
language=$3
fun_name=${1}_${2}
#args=$4
#output=$5
#extras=$6

# Find system constants
Nx=`mtt_getsize $system x` # States
Nxx=`mtt_getsize $system xx` # States x States
Nu=`mtt_getsize $system u` # Inputs 
Ny=`mtt_getsize $system y` # Outputs 
Nyz=`mtt_getsize $system yz` # Zero outputs
##Npar=`wc -l $system\_sympar.txt | awk '{print $1}'`

# Representation-specific stuff

eqnargs='mttx,mttu,mttt,mttpar'
inputeqnargs='mttx,mtty,mttt,mttpar'
case $rep in
    cse)
	states=yes;
        inputs=yes;
	parameters=yes;
        output='mttdx,mtte'
        args=$eqnargs
	;;
    csex)
	states=yes;
        inputs=yes;
	parameters=yes;
        output=mttedx
        args=$eqnargs
	;;
    cseo)
	states=yes;
        inputs=yes;
	parameters=yes;
        output=mtty
        args=$eqnargs
	;;
    dm)
	states=no;
	inputs=no;
	parameters=yes;
        output='mtta,mttb,mttc,mttd,mtte'
        args=mttpar
        zeromatrices='a b c d e';
	;;
   input)
	states=yes;
	inputs=no;
	parameters=yes;
        output=mttu
        args=$inputeqnargs
        declareinputs=yes
	;;
    logic)
	states=no;
	inputs=no;
	parameters=yes;
        output=mttopen
        args=$eqnargs
        declareinputs=yes
        declarestates=yes
	;;
    numpar)
	states=no;
	inputs=no;
	parameters=no;
        output='mttpar'
	;;
    ode)
	states=yes;
        inputs=yes;
	parameters=yes;
        output='mttdx'
        args=$eqnargs
	;;
    odeo)
	states=yes;
        inputs=yes;
	parameters=yes;
        output='mtty'
        args=$eqnargs
	;;
    ode2odes)
	states=no;
        inputs=no;
	parameters=no;
        output='y,x,t'
        args='x,par,simpar'
	;;
    simpar)
	states=no;
	inputs=no;
	parameters=no;
        output='mttsimpar'
	;;
    sm)
	states=no;
	inputs=no;
	parameters=yes;
        output='mtta,mttb,mttc,mttd'
        args=mttpar;
        zeromatrices='a b c d';
	;;
     smxa)
	states=no;
        inputs=no;
	parameters=yes;
        output='mtta'
        args=$eqnargs
	;;
    smxax)
	states=no;
        inputs=no;
	parameters=yes;
        output='mttax'
        args=$eqnargs
	;;
    state)
	states=no;
	inputs=no;
	parameters=yes;
        output=mttx
        args=mttpar
        declarestates=yes
	;;
    *)
	echo Representation $rep not supported - sorry; exit 1
esac

## Sort out parentheses
if [ -n "$args" ]; then
    Args='('$args')'
fi
if [ -n "$output" ]; then
    Output="[$output] = "
fi


# Lanuage specific stuff
case $language in
    m)
	Lc='##';
	Rc='';
	Lb='(';
	Rb=')';
	function="function"
	declaration="$Output$1_$rep$Args;"
	noglobals=true; # Fudge to make mtt_m2p work
        start='## BEGIN Code'
        finish='## END Code'
        var_declaration=$Lc
        declarestates=no
        declareinputs=no
	;;
    txt)
	modeline='## -*-octave-*- Put Emacs into octave-mode ##';
	Lc='##';
	Rc='';
	Lb='(';
	Rb=')';
	function=""
	declaration=""
        start=''
        parameters=no
	states=no
	inputs=no
        declarestates=no
        declareinputs=no
	;;
    oct)
	modeline="// -*-c++-*- Put Emacs into c++-mode";
	Lc='//';
	oct_header=yes;
        constant_declaration="const double "
        var_declaration="double "
	minusone="-1"
	map="_map"
        declaredummies=yes
	;;
    *)
	echo Language $language not supported - sorry; exit 1
esac

if [ "$rep" = "simpar" ]; then
   output=${output}${map}    # Output is simpar_map in this case
fi

function zero_matrices(){
## Set matrices to zero
echo
 ## echo '## Set matrices to zero'
for name in $zeromatrices; do
    case $name in
	a)
	    N=$Nx; M=$Nx
	    ;;
	b)
	    N=$Nx; M=$Nu
	    ;;
	c)
	    N=$Ny; M=$Nx
	    ;;
	d)
	    N=$Ny; M=$Nu
	    ;;
	e)
	    N=$Nx; M=$Nx
	    ;;
	*)
	    
    esac
    echo "   mtt$name = zeros($N,$M);"
done
}
function declare_dummies(){
# Get the dummies
dummies="mtt_tmp"
rm -f mtt_dummies
for dummy in $dummies; do
    grep "${dummy}[0-9]* " < ${fun_name}.m |\
    awk '{ 
          # if (match(dummy,$1)==1)
             print $1
         }' dummy=$dummy | sort -u >> mtt_dummies
done

dummy_list=`sort -u mtt_dummies`

# Comments
cat <<EOF

$Lc  Declarations of dummies $Rc
EOF

for dummy in $dummy_list; do
    echo '  ' $var_declaration $dummy';'
done
} # declare_dummies

function declare_vars(){
# Grab the names
names=`awk '{if ($1==var_type) print tolower($4)}' var_type=$1 ${system}_struc.txt`

# Comments
cat <<EOF

$Lc  Declarations for $1 names $Rc
EOF
# Declarations
for name in $names; do
    echo '  '$var_declaration $name';'
done
}


function array2constant() {
# Parameters
if [ "$parameters" = "yes" ]; then
cat <<EOF

$Lc Parameters $Rc
EOF
sympar2par_txt2m ${system} ""  "$constant_declaration" "$minusone"
cat <<EOF

$Lc Switches $Rc
EOF
strip_comments <${system}_switch.txt | awk '{printf("  int %s = 0;\n", tolower($1))}' 

fi

# States
if [ "$states" = "yes" ]; then
cat <<EOF

$Lc States $Rc
EOF
N=`n2m 1 $Nx`
for i in $N; do
    echo $constant_declaration 'mttx'$i' = mttx('$i$minusone');'
done
fi

if [ "$declarestates" = "yes" ]; then
  declare_vars state
fi

# Inputs
if [ "$inputs" = "yes" ]; then
cat <<EOF

$Lc Inputs $Rc
EOF

N=`n2m 1 $Nu`
for i in $N; do
  echo $constant_declaration 'mttu'$i' = mttu('$i$minusone');'
done
fi

if [ "$declareinputs" = "yes" ]; then
  declare_vars input
fi

if [ "$declaredummies" = "yes" ]; then
  declare_dummies
fi

zero_matrices;

}

# Argument specific stuff
function get_arg_specific_stuff ()
{
    arg_name=${1:-""}
    case ${arg_name} in
	mtta | mtte)
	    arg_type="Matrix"
	    arg_size="(MTTNX,MTTNX)"
	    ;;
	mttb)
	    arg_type="Matrix"
	    arg_size="(MTTNX,MTTNU)"
	    ;;
	mttc)
	    arg_type="Matrix"
	    arg_size="(MTTNY,MTTNX)"
	    ;;
	mttd)
	    arg_type="Matrix"
	    arg_size="(MTTNY,MTTNU)"
	    ;;
	mttax | mttdx | mttedx | mttx | mttopen)
	    arg_type="ColumnVector"
	    arg_size="(MTTNX)"
	    ;;
	mttpar)
	    arg_type="ColumnVector"
	    arg_size="(MTTNPAR)"
	    ;;
	mttsimpar_map)
	    arg_type="Octave_map"
	    arg_size="";
	    ;;
	mttu)
	    arg_type="ColumnVector"
	    arg_size="(MTTNU)"
	    ;;
	mtty)
	    arg_type="ColumnVector"
	    arg_size="(MTTNY)"
	    ;;
	mttt)
	    arg_type="const double"
	    arg_size=""
	    ;;
	nil)
	    arg_type="void *"
	    arg_size="(0x0)"
	    ;;
	*)
	    echo "Argument ${arg} not supported - sorry"; exit 1
    esac
}


function get_field ()
{ # parse comma separated string
    s=${1:-""}					# comma separated string
    i=${2:-0}					# field number in string

    if [ 0 -eq ${i} ]; then			# return number of fields
	echo ${s} |\
	awk -F\, '{ print NF }'
    else					# return ith field
	echo ${s} |\
	awk -F\, -v i=${i} '{ print $i }'
    fi
}


function get_extra_fields ()
{ # return list of words in s2 and not in s1
    s1=${1:-""}					# comma separated list
    s2=${2:-""}					# comma separated list

    c1=$(get_field ${s1} 0)			# count words in s1
    c2=$(get_field ${s2} 0)			# count words in s2
	
    ans=""
	
    i2=0					# s2 word index
    while [ ${i2} -lt ${c2} ]; do
        flag=0					# appearance of word in s1 and s2?
	i2=$((${i2} + 1))
	w2=$(get_field ${s2} ${i2})		# i2 th word in s2
	i1=0					# s1 word index
	while [ ${i1} -lt ${c1} ]; do
	    i1=$((${i1} + 1))
	    w1=$(get_field ${s1} ${i1})		# i1 th word in s1
	    if [ ${w2} = ${w1} ]; then
		flag=1				# w2 occurs in s1
	    fi
        done
	if [ ${flag} -eq 0 ]; then		# w2 is not in s1?
	    if [ -z ${ans} ]; then		#  string is empty?
		ans=${w2}			#   assign w2
	    else
		ans=${ans},${w2}		#   append w2
	    fi
        fi
    done
    echo ${ans}
}


function write_DLD_header ()
{
    cat <<EOF

#include <octave/oct.h>
#include <octave/ov-struct.h>
#include <octave/toplev.h>
#include <math.h>

#include "useful-functions.hh"
#include "${system}_def.h"
#include "${system}_sympar.h"

DEFUN_DLD (${system}_${rep}, args, ,
"Usage: [$output] = ${system}_${rep}($args)
Octave ${rep} representation of system ${system}
Generated by MTT on $(date)")
{

  octave_value_list retval;

EOF
}


function map_DLD_inputs ()
{
    s=${1:-""}					# comma separated input list
    if [ -z ${s} ];then return; fi
    c=$(get_field ${s} 0)			# count of inputs
    i=0
    printf "  if (${c} != args.length ()) usage (\"${fun_name} expected ${c} argument(s): ${s}\");\n\n"
    while [ ${i} -lt ${c} ]; do
	j=${i}
	i=$((${i} + 1))
	w=$(get_field ${s} ${i})		# argument name
	get_arg_specific_stuff ${w}
	case ${arg_type} in
	    "const double")
		printf "  ${arg_type}\t${w}\t= args(${j}).double_value ();\n"
		;;
	    ColumnVector | Matrix | *)
		printf "  ${arg_type}\t${w}\t= args(${j}).vector_value ();\n"
		;;
	esac
    done
    printf "\n"
}	


function declare_DLD_outputs ()
{
    s=${1:-""}					# comma separated output list
    c=$(get_field ${s} 0)			# count of outputs
    i=0
    while [ ${i} -lt ${c} ]; do
	i=$((${i} + 1))
	w=$(get_field ${s} ${i})		# argument name
	get_arg_specific_stuff ${w}
	printf "  ${arg_type}\t${w}\t${arg_size};\n"
    done
}


function return_DLD_outputs ()
{
    s=${1:-""}					# comma separated output list
    c=$(get_field ${s} 0)			# count of outputs
    i=0
    cat <<EOF

// END Code

EOF
    while [ ${i} -lt ${c} ]; do
	j=${i}
	i=$((${i} + 1))
	w=$(get_field ${s} ${i})
	printf "  retval (${j})\t= octave_value (${w});\n"
    done
    printf "\n  return (retval);\n}\n"
}


# Header information
cat<<EOF
$modeline
$function $declaration
$Lc $declaration
$Lc System $system, representation $rep, language $language; $Rc
$Lc File $1_$rep.$language; $Rc
$Lc Generated by MTT on `date`; $Rc
EOF

if [ ${language} = "oct" ];then
    write_DLD_header
    map_DLD_inputs ${args}
    undeclared=$(get_extra_fields ${args:-"nil"} ${output:-"nil"})
    declare_DLD_outputs ${undeclared}
    array2constant
 	case ${arg_type} in
 	    Matrix)
 		printf "  ${w}\t\t\t= zeros ${arg_size};\n"
 		;;
 	    *)
 		;;
 	esac

    cat <<EOF

// BEGIN Code

EOF
    return_DLD_outputs ${output}
else

if [ -n "$noglobals" ]; then
cat<<EOF

## Horrible fudge to make mtt_m2p work
global ...
mtt_no_globals ;
EOF
fi

## Arrays 
array2constant

# Mark start of code
echo
echo $start

fi
