/** 
 * This is a list of hand-coded defs for R_lpx.c -- the translator doesn't get 
 * these right.
 **/

/*** void lpx_delete_prob(LPX *lp); ***/
SEXP R_lpx_delete_prob(SEXP lp)
{
    SEXP ret = R_NilValue;
    LPX *lpx = NULL;

    R_LPX_TYPE_CHECK(lp);

    if (R_glpk_setjmp()) goto end;

    lpx = R_ExternalPtrAddr(lp);
    if (lpx)
      {
        lpx_delete_prob(lpx);
        R_ClearExternalPtr(lp);
      }
end:
    return ret;
}

/** glpk api: LPX *lpx_read_model(char *model, char *data, char *output); **/
SEXP R_lpx_read_model(SEXP model, SEXP data, SEXP output)
{
    SEXP ret = R_NilValue;
    LPX * xret = 0;


    if (R_glpk_setjmp()) goto end;

    xret = lpx_read_model(CHARACTER_VALUE(model), 
                          R_GLPK_CHARACTER_VALUE(data), 
                          R_GLPK_CHARACTER_VALUE(output));
    if (xret)
      {
        ret = R_MakeExternalPtr(xret, LPX_type_tag, R_NilValue);
        R_RegisterCFinalizer(ret, (R_CFinalizer_t) R_lpx_delete_prob);
      } 
end:
    return ret;
} 

/** R-specifc routine for in-out parameters **/

typedef int (*GetVecLen) (LPX *lp);
typedef int (*GetVec)    (LPX *lp, int i, int ind[], double val[]);

static SEXP 
get_mat_vector(SEXP lp, SEXP i, GetVecLen get_vec_len, GetVec get_vec) 
{
    int len, xret = 0;
    SEXP n, ind, val, names, listret = R_NilValue;

    R_LPX_TYPE_CHECK(lp);

    len = get_vec_len(R_ExternalPtrAddr(lp));

    PROTECT(ind = NEW_INTEGER(len));
    PROTECT(val = NEW_NUMERIC(len));

    if (!R_glpk_setjmp())
      {
        xret = get_vec(R_ExternalPtrAddr(lp), 
                       INTEGER_VALUE(i), 
                       &(INTEGER_POINTER(ind)[-1]), 
                       &(NUMERIC_POINTER(val)[-1]));
        if (xret)
          {
            PROTECT(n = NEW_INTEGER(1));
            INTEGER_POINTER(n)[0] = xret;
            
            PROTECT(names = NEW_CHARACTER(3));
            SET_ELEMENT(names, 0, mkChar("n"));
            SET_ELEMENT(names, 1, mkChar("ind"));
            SET_ELEMENT(names, 2, mkChar("val"));

            PROTECT(listret = NEW_LIST(3));
            SET_ELEMENT(listret, 0, n);
            SET_ELEMENT(listret, 1, ind);
            SET_ELEMENT(listret, 2, val);
            SET_NAMES(listret, names);

            UNPROTECT(3);
          }
      }
    UNPROTECT(2);
    return listret;
} 

/** glpk api: int lpx_get_mat_row(LPX *lp, int i, int ind[], double val[]); **/
SEXP R_lpx_get_mat_row(SEXP lp, SEXP i)
{
    return get_mat_vector(lp, i, lpx_get_num_rows, lpx_get_mat_row);
} 

/** glpk api: int lpx_get_mat_col(LPX *lp, int j, int ind[], double val[]); **/
SEXP R_lpx_get_mat_col(SEXP lp, SEXP j)
{
    return get_mat_vector(lp, j, lpx_get_num_cols, lpx_get_mat_col);
} 


