qfrontend.cpp

来自「算断裂的」· C++ 代码 · 共 775 行 · 第 1/2 页

// ------------------------------------------------------------------
// qfrontend.cpp
//
// This file contains functions associated with the interface to
// the front-end language.  For this version of qfrontend, the
// front-end language is tcl/tk.  See qfrontend.h
// ------------------------------------------------------------------
// Author: Stephen A. Vavasis
// Copyright (c) 1999 by Cornell University.  All rights reserved.
// 
// See the accompanying file 'Copyright' for authorship information,
// the terms of the license governing this software, and disclaimers
// concerning this software.
// ------------------------------------------------------------------
// This file is part of the QMG software.  
// Version 2.0 of QMG, release date September 3, 1999.
// ------------------------------------------------------------------

#ifdef _MSC_VER
#if _MSC_VER == 1200
#include "qmatvec.h"
#endif
#endif

#include "qfrontend.h"
#include "qbrep_constr.h"
#include "qsimpcomp.h"
#include "qmatvec.h"


namespace QMG {
  namespace FrontEnd {
    using namespace QMG;
    extern Brep_From_FrontEnd get_brep_from_obj(Tcl_Interp* interp, Tcl_Obj* obj, int& returncode);
    extern SimpComplex_From_FrontEnd
      get_simpcomp_from_obj(Tcl_Interp* interp, Tcl_Obj* obj, int& returncode);
    extern Tcl_Obj* new_simpcomp_obj(Cptc_MshDesc* mesh);
    extern Tcl_Obj* new_brep_obj(Cptc_GeomDesc* geo);
    extern Object_Type_Code get_obj_type(Tcl_Interp* interp, Tcl_Obj* obj);
  }
}





QMG::FrontEnd::ArgValType::ArgValType(int objc, Tcl_Obj* const objv[], Tcl_Interp* interp) {
  objc_ = objc - 1;
  objv_ = &objv[1];
  interp_ = interp;
}

QMG::FrontEnd::ArgValType::~ArgValType() {
}

void 
QMG::FrontEnd::ArgValType::verify_nargin(int narginmin, 
                                         int narginmax, 
                                         const char* routine_name) const {
  if (objc_ < narginmin || objc_ > narginmax) {
    ostringstream ostr;
    if (narginmin == narginmax) {
      ostr << "Routine expected " << narginmin << " argument";
      if (narginmin != 1)
        ostr << "s";
    }
    else  {
      ostr << "Routine expected " << narginmin << " to " << narginmax << " arguments";
    }
    ostr << " but " << objc_ << " were given";
    throw_error(ostr.str());
  }
}

int QMG::FrontEnd::ArgValType::nargin() const {
  return objc_;
}


QMG::string 
QMG::FrontEnd::ArgValType::get_string(int argidx) const {
#ifdef RANGECHECK
  if (argidx < 0 || argidx >= objc_)
    throw_error("Argidx range error 1");
#endif
  return string(Tcl_GetStringFromObj(objv_[argidx],0));
}


int 
QMG::FrontEnd::ArgValType::get_int(int argidx) const {
#ifdef RANGECHECK
  if (argidx < 0 || argidx >= objc_)
    throw_error("Argidx range error 2");
#endif
  int returnval;
  int returncode = Tcl_GetIntFromObj(interp_, objv_[argidx], &returnval);
  if (returncode != TCL_OK) {
    ostringstream ostr;
    ostr << "Conversion of argument #" << argidx << " to integer failed";
    throw_error(ostr.str());
  }
  return returnval;
}


double 
QMG::FrontEnd::ArgValType::get_double(int argidx) const {

#ifdef RANGECHECK
  if (argidx < 0 || argidx >= objc_)
    throw_error("Argidx range error 3");
#endif
  double returnval;
  int returncode = Tcl_GetDoubleFromObj(interp_, objv_[argidx], &returnval);
  if (returncode != TCL_OK) {
    ostringstream ostr;
    ostr << "Conversion of argument #" << argidx << " to double failed";
    throw_error(ostr.str());
  }
  return returnval;
}

QMG::Brep_From_FrontEnd
QMG::FrontEnd::ArgValType::get_brep(int argidx) const {
#ifdef RANGECHECK
  if (argidx < 0 || argidx >= objc_)
    throw_error("Argidx range error 4");
#endif
  int returncode;
  Brep_From_FrontEnd b = get_brep_from_obj(interp_, objv_[argidx], returncode);
  if (returncode != TCL_OK) {
    ostringstream ostr;
    ostr << "Conversion of argument #" << argidx << " to brep failed";
    throw_error(ostr.str());
  }
  return b;
}


Tcl_Obj*
QMG::FrontEnd::ArgValType::get_tcl_obj(int argidx) const {
  return objv_[argidx];
}


QMG::SimpComplex_From_FrontEnd
QMG::FrontEnd::ArgValType::get_simpcomp(int argidx) const {
#ifdef RANGECHECK
  if (argidx < 0 || argidx >= objc_)
    throw_error("Argidx range error 4a");
#endif
  int returncode;
  SimpComplex_From_FrontEnd s = get_simpcomp_from_obj(interp_, objv_[argidx], returncode);
  if (returncode != TCL_OK) {
    ostringstream ostr;
    ostr << "Conversion of argument #" << argidx << " to simpcomplex failed";
    throw_error(ostr.str());
  }
  return s;
}

QMG::Object_Type_Code 
QMG::FrontEnd::ArgValType::determine_argument_type(int argidx) const {
#ifdef RANGECHECK
  if (argidx < 0 || argidx >= objc_)
    throw_error("Argidx range error 4b");
#endif  
  Object_Type_Code code = get_obj_type(interp_, objv_[argidx]);
  if (code != BREP && code != SIMPCOMPLEX) {
    ostringstream ostr;
    ostr << "Argument #" << argidx << " is neither simpcomplex nor brep";
    throw_error(ostr.str());
  }
  return code;
}


bool
QMG::FrontEnd::ArgValType::get_bool(int argidx) const {
#ifdef RANGECHECK
  if (argidx < 0 || argidx >= objc_)
    throw_error("Argidx range error 5");
#endif
  int returnval;
  int returncode = Tcl_GetIntFromObj(interp_, objv_[argidx], &returnval);
  if (returncode != TCL_OK || (returnval != 0 && returnval != 1)) {
    ostringstream ostr;
    ostr << "Conversion of argument #" << argidx << " to bool failed";
    throw_error(ostr.str());
  }

  return returnval == 1;
}


#ifndef BUG_IN_USING
using QMG::vector;
#endif

vector<double>
QMG::FrontEnd::ArgValType::get_vector_double(int argidx) const {
#ifdef RANGECHECK
  if (argidx < 0 || argidx >= objc_)
    throw_error("Argidx range error 6");
#endif
  int doublec;
  Tcl_Obj** doublev;
  int returncode = Tcl_ListObjGetElements(interp_, objv_[argidx], &doublec, &doublev);
  if (returncode != TCL_OK) {
    ostringstream ostr;
    ostr << "Conversion of argument #" << argidx << " to list failed";
    throw_error(ostr.str());
  }
  vector<double> returnval(doublec, 0.0);
  for (int j = 0; j < doublec; ++j) {
    returncode = Tcl_GetDoubleFromObj(interp_, doublev[j], &returnval[j]);
    if (returncode != TCL_OK) {
      ostringstream ostr;
      ostr << "Conversion of argument #" << argidx << " (entry " << j << ") to double failed";
      throw_error(ostr.str());
    }
  }
  return returnval;
}

vector<QMG::string>
QMG::FrontEnd::ArgValType::get_vector_string(int argidx) const {
#ifdef RANGECHECK
  if (argidx < 0 || argidx >= objc_)
    throw_error("Argidx range error vs");
#endif
  int stringc;
  Tcl_Obj** stringv;
  int returncode = Tcl_ListObjGetElements(interp_, objv_[argidx], &stringc, &stringv);
  if (returncode != TCL_OK) {
    ostringstream ostr;
    ostr << "Conversion of argument #" << argidx << " to list failed";
    throw_error(ostr.str());
  }
  vector<string> returnval(stringc, "");
  for (int j = 0; j < stringc; ++j) {
    int strlen1;
    char* str1 = Tcl_GetStringFromObj(stringv[j], &strlen1);
    returnval[j] = string(str1, strlen1);
  }
  return returnval;
}




QMG::Matrix
QMG::FrontEnd::ArgValType::get_matrix(int argidx) const {
#ifdef RANGECHECK
  if (argidx < 0 || argidx >= objc_)
    throw_error("Argidx range error 6a");
#endif  

  int numrows;
  Tcl_Obj** rows;
  
  int returncode = Tcl_ListObjGetElements(interp_, objv_[argidx], &numrows, &rows);
  if (returncode != TCL_OK) {
    ostringstream ostr;
    ostr << "Conversion of argument #" << argidx << " to matrix failed -- arg not a list";
    throw_error(ostr.str());
  }

  if (numrows == 0)
    return Matrix(0,0);


  int numcols;
  Tcl_Obj** onerow;
  returncode = Tcl_ListObjGetElements(interp_, rows[0], &numcols, &onerow);
  if (returncode != TCL_OK) {
    ostringstream ostr;
    ostr << "Conversion of argument #" << argidx 
      << " to matrix failed -- first list entry not a list";
    throw_error(ostr.str());
  }

  Matrix m(numrows, numcols);
  int numcols1;
  double val;
  for (int j = 0; j < numrows; ++j) {
    if (j > 0) {
      returncode = Tcl_ListObjGetElements(interp_, rows[j], &numcols1, &onerow);
      if (returncode != TCL_OK) {
        ostringstream ostr;      
        ostr << "Conversion of argument #" << argidx 
          << " to matrix failed -- outer list entry not a list";
        throw_error(ostr.str());
      }
      if (numcols1 != numcols) {
        ostringstream ostr;      
        ostr << "Conversion of argument #" << argidx 
          << " to matrix failed -- all rows must have same number of entries";
        throw_error(ostr.str());
      }
    }
    for (int k = 0; k < numcols; ++k) {
      returncode = Tcl_GetDoubleFromObj(interp_, onerow[k], &val);
      if (returncode != TCL_OK) {
        ostringstream ostr;      
        ostr << "Conversion of argument #" << argidx 
          << " to matrix failed -- couldn't convert entry to number";
        throw_error(ostr.str());
      }
      m(j,k) = val;
      
    }
  }
  return m;
}

QMG::Matrix
QMG::FrontEnd::ArgValType::get_zbamatrix(int argidx) const {
return get_matrix(argidx);
}




QMG::IntMatrix
QMG::FrontEnd::ArgValType::get_intmatrix(int argidx) const {
#ifdef RANGECHECK
  if (argidx < 0 || argidx >= objc_)
    throw_error("Argidx range error 6a1");
#endif  

  int numrows;
  Tcl_Obj** rows;
  
  int returncode = Tcl_ListObjGetElements(interp_, objv_[argidx], &numrows, &rows);
  if (returncode != TCL_OK) {
    ostringstream ostr;
    ostr << "Conversion of argument #" << argidx << " to intmatrix failed -- arg not a list";
    throw_error(ostr.str());
  }

  if (numrows == 0)
    return IntMatrix(0,0);


  int numcols;
  Tcl_Obj** onerow;
  returncode = Tcl_ListObjGetElements(interp_, rows[0], &numcols, &onerow);
  if (returncode != TCL_OK) {
    ostringstream ostr;
    ostr << "Conversion of argument #" << argidx 
      << " to intmatrix failed -- first list entry not a list";
    throw_error(ostr.str());
  }

  IntMatrix m(numrows, numcols);
  int numcols1;
  int val;
  for (int j = 0; j < numrows; ++j) {
    if (j > 0) {
      returncode = Tcl_ListObjGetElements(interp_, rows[j], &numcols1, &onerow);
      if (returncode != TCL_OK) {
        ostringstream ostr;      
        ostr << "Conversion of argument #" << argidx 
          << " to intmatrix failed -- outer list entry not a list";
        throw_error(ostr.str());
      }
      if (numcols1 != numcols) {
        ostringstream ostr;      
        ostr << "Conversion of argument #" << argidx 
          << " to intmatrix failed -- all rows must have same number of entries";
        throw_error(ostr.str());
      }
    }
    for (int k = 0; k < numcols; ++k) {
      returncode = Tcl_GetIntFromObj(interp_, onerow[k], &val);
      if (returncode != TCL_OK) {
        ostringstream ostr;      
        ostr << "Conversion of argument #" << argidx 
          << " to matrix failed -- couldn't convert entry to number";
        throw_error(ostr.str());
      }
      m(j,k) = val;
      
    }
  }
  return m;