#include <LINK/basic/ElementOps.h>

#include <stk.h>
#include <LINK/stkWrapper/LINK_STk.h>
#include <LINK/stkWrapper/MatrixWrapper.h>
typedef double _double;
typedef MatrixWrapper<double > _MatrixWrapper_double_;
PRIMITIVE
MatrixWrapper<_double>::makeFilledLinkMatrix(SCM row, SCM col,  SCM e)
{
        int i, j;
        int r = STk_integer_value(row);
        int c = STk_integer_value(col);
        SCM ns;
        double val = getNumber(e);
        Matrix<_double>* new_matrix;
        int &Matrix_Type = Wrapper<Matrix<_double> >::type;
        char*Matrix_Name = Wrapper<Matrix<_double> >::name;
        new_matrix = new Matrix<_double>(r,c);
        ns = STk_make_CXXwrapper(Matrix_Type,Matrix_Name,
                                 (void*)new_matrix,LINK_DYNAMIC);
        for (i=0; i<r; i++)
                for (j=0; j<c; j++)
                        (*new_matrix)(i,j) = val;
        return ns;
}

PRIMITIVE
MatrixWrapper<double>::fillLinkMatrix(SCM l, SCM e)
{
        int i, j, rows, cols;
        Matrix<double>* a;
        if  (CXX_NTYPEP(l, Wrapper<Matrix<double> >::type))
                Err("typed-matrix-insert: argument not an matrix", l);
        if (isMatrix(l))
                a = getMatrix(l);
        double elem =  getNumber(e);
        rows = a->numRows();
        cols = a->numCols();
        for (i=0; i<rows; i++)          //or else it needs an allocation() mth.
                for (j=0; j<cols; j++)
                        (*a)(i,j) = elem;
        return UNDEFINED;
}
PRIMITIVE
MatrixWrapper<double>::stkList2LinkMatrix(SCM rows, int len)
{
        SCM row;
        Tcl_HashEntry *p;
        if (len <= 0)
                return Ntruth;
        else {
                row = CAR(rows);
        }
        if (NCONSP(rows)) {
               Err("matrix: bad arg 1, list of lists expected", rows);
        }
        if (NCONSP(row)) {
               Err("matrix: bad arg 1, list of lists expected", row);
        }
        int numrows = STk_llength(rows);
        int numcols = STk_llength(row);
        //
        // make sure each row has numcols columns
        //
        SCM l=rows, l2;
        for (;;) {
                if (NULLP(l))
                        break;
                if (STk_llength(CAR(l)) != numcols)
                        Err("matrix: bad number of columns: ", CAR(l));
                l = CDR(l);
        }
        Matrix<double> *m = new Matrix<double>(numrows, numcols);
        int i=0, j=0;
        l = rows;
        for (;;) {
                if ((NULLP(l)) || (NCONSP(CAR(l))))
                        break;
                l2 = CAR(l);
                j=0;
                for (;;) {
                        if (NULLP(l2))
                                break;
                        if (!NUMBERP(CAR(l2)))
                                Err("matrix: bad argument type: ", CAR(l2));
                        (*m)(i,j) = getNumber(CAR(l2));
                        l2 = CDR(l2);
                        j++;
                }
                l = CDR(l);
                i++;
        }
        int &Matrix_Type = Wrapper<Matrix<double> >::type;
        char*Matrix_Name = Wrapper<Matrix<double> >::name;
        PRIMITIVE ns = STk_make_CXXwrapper(Matrix_Type,Matrix_Name,
                                 (void*)m,LINK_DYNAMIC);
        return ns;
}
PRIMITIVE
MatrixWrapper<double>::linkMatrix2STkList(SCM l)
{
        if (!isMatrix(l))
                Err("typed-matrix-convert: wrong type of argument", l);
        Matrix<double> *cp = getMatrix(l);
        int numrows=0, numcols=0;
        if (cp) {
                numrows = cp->numRows();
                numcols = cp->numCols();
        }
        double e;
        int i, j;
        SCM head_row=NIL, new_row;
        for (i=0; i<numrows; i++) {
           SCM newnode=NIL, head=NIL;
           for (j=0; j<numcols; j++) {
                e = (*cp)(i, j);
                SCM new_el = STk_makenumber(e);
                NEWCELL(newnode, tc_cons);
                CAR(newnode) = new_el;
                CDR(newnode) = head;
                head = newnode;
          }
          NEWCELL(new_row, tc_cons);
          CAR(new_row) = STk_reverse(head);
          CDR(new_row) = head_row;
          head_row = new_row;
        }
        return STk_reverse(head_row);
}

PRIMITIVE
MatrixWrapper<double>::refLinkMatrix(SCM l, SCM i, SCM j)
{
        SCM res = NIL;
        Matrix<double>* cp;
        long r = STk_integer_value(i);
        long c = STk_integer_value(j);
        if (isMatrix(l)) {
                cp = getMatrix(l);
                double t = (*cp)(r, c);
                res = STk_makenumber(t);
        }
        return res;
}
PRIMITIVE
MatrixWrapper<double>::setLinkMatrix(SCM alist, int len)
{
        if (len < 4)
                Err("usage: typed-matrix-set m i j e", alist);
        SCM l = CAR(alist);
        SCM i = CAR(CDR(alist));
        SCM j = CAR(CDR(CDR(alist)));
        SCM e = CAR(CDR(CDR(CDR(alist))));
        Matrix<double>* cp;
        if (!NUMBERP(e))
                Err("typed-matrix-set: wrong type of argument", e);
        long r = STk_integer_value(i);
        long c = STk_integer_value(j);
        if (isMatrix(l)) {
                double elem = FLONM(e);
                cp = getMatrix(l);
                (*cp)(r, c) = elem;
        }
        return UNDEFINED;
}
