GVariant * scheme_obj_to_gvariant (Scheme_Object *list) { GVariant *rvalue; Scheme_Object *firstelement; int length; long i; char* rstring; double rdouble; rvalue = NULL; length = scheme_list_length (list); if (length == 0) { return rvalue ; } else if (length == 1) { // Get the first element of the argument firstelement = scheme_car (list); // checking the scheme_type to see whether it is an integer or not // Eventually see if we can convert this to a switch statement. if (SCHEME_TYPE (firstelement)== scheme_integer_type) { // we saved the return value at &i scheme_get_int_val (list,&i); // we concert it to g_variant rvalue = g_variant_new ("(i)", i); return rvalue; } // if it's an integer else if (SCHEME_TYPE (firstelement) == scheme_char_type) { //getting the string out of the scheme_object rstring = SCHEME_BYTE_STR_VAL(list); // we will convert it to g_variant rvalue = g_variant_new_string(rstring); return rvalue; } // if it's a character else if (SCHEME_TYPE (firstelement) == scheme_double_type) { //getting the double out of the scheme_object rdouble = scheme_real_to_double(list); // we will convert it to g_variant rvalue = g_variant_new_double(rdouble); return rvalue; } // if it's a double } // if we have a single element return rvalue; } // scheme_obj_to_gvariant
/* Every C implementation of a Scheme function takes argc and an array of Scheme_Object* values for argv, and returns a Scheme_Object*: */ static Scheme_Object *sch_fmod(int argc, Scheme_Object **argv) { /* Because we'll use scheme_make_prim_w_arity, MzScheme will have already checked that we're getting the right number of arguments. */ Scheme_Object *a = argv[0], *b = argv[1]; double v; /* Make sure we got real numbers, and complain if not: */ if (!SCHEME_REALP(a)) scheme_wrong_type("fmod", "real number", 0, argc, argv); /* 1st arg wrong ----^ */ if (!SCHEME_REALP(b)) scheme_wrong_type("fmod", "real number", 1, argc, argv); /* 2nd arg wrong ----^ */ /* Convert the Scheme numbers to double-precision floating point numbers, and compute fmod: */ v = fmod(scheme_real_to_double(a), scheme_real_to_double(b)); /* Return the result, packaging it as a Scheme value: */ return scheme_make_double(v); }
/** *Translating the scheme_object to gvariant type for the client *This step is used on sending input values onto the DBus */ GVariant * scheme_obj_to_gvariant (Scheme_Object *list) { GVariantBuilder *builder; GVariant *finalr; GVariant *rvalue = NULL; Scheme_Object *firstelement; int length = 0; gint32 i; char* rstring; double rdouble; builder = g_variant_builder_new(G_VARIANT_TYPE_TUPLE); length = scheme_list_length (list); // rvalue = g_new(GVariant *, length); if (length == 0) { // scheme_signal_error("length 0"); return rvalue ; } // if else{ while (length != 0) { // Get the first element of the argument firstelement = scheme_car (list); list = scheme_cdr(list); length = scheme_list_length(list); // checking the scheme_type to see whether it is an integer or not // Eventually see if we can convert this to a switch statement. if (SCHEME_INTP (firstelement)) { // we saved the return value at &i i = SCHEME_INT_VAL(firstelement); rvalue = g_variant_new ("i",i); g_variant_builder_add_value(builder,rvalue); // return rvalue; } // if it's an integer else if (SCHEME_BYTE_STRINGP (firstelement)|| SCHEME_CHAR_STRINGP(firstelement)) { //scheme_signal_error ("We are in Character"); //getting the string out of the scheme_object rstring = SCHEME_BYTE_STR_VAL(list); // we will convert it to g_variant rvalue = g_variant_new ("(&s)", rstring); g_variant_builder_add_value(builder, rvalue); } // if it's a character else if (SCHEME_TYPE (firstelement) == scheme_double_type) { //getting the double out of the scheme_object rdouble = scheme_real_to_double(list); // we will convert it to g_variant rvalue = g_variant_new_double(rdouble); g_variant_builder_add_value(builder, rvalue); } // if it's a double } // while loop finalr = g_variant_builder_end (builder); return finalr; } //else return finalr; } // scheme_obj_to_gvariant
void TpMzScheme::evalDesign(Design::Ptr d){ DesignStore::Ptr ds = Game::getGame()->getDesignStore(); if (scheme_setjmp(scheme_error_buf)) { Logger::getLogger()->warning("MzScheme Error"); } else { Scheme_Object* temp; std::ostringstream formater; formater.str(""); formater << "(define-values (struct:designType make-designType designType? designType-ref designType-set!)(make-design-type " << ds->getMaxPropertyId() << "))"; temp = scheme_eval_string(formater.str().c_str(), env); temp = scheme_eval_string("(define property-designType-set! (lambda (design id val) (designType-set! design (- id 1) val)))", env); std::set<uint32_t> propids = ds->getPropertyIds(); for(std::set<uint32_t>::iterator propit = propids.begin(); propit != propids.end(); ++propit){ // for each property type Property::Ptr p = ds->getProperty(*propit); if(p){ formater.str(""); formater << "(define designType." << p->getName() << " (make-property-accessor designType-ref " << p->getPropertyId() << " \"" << p->getName() << "\" ))"; temp = scheme_eval_string(formater.str().c_str(), env); } } propids.clear(); IdMap complist = d->getComponents(); temp = scheme_eval_string("(define design (make-designType))", env); for(std::set<uint32_t>::iterator propit = propids.begin(); propit != propids.end(); ++propit){ formater.str(""); formater << "(property-designType-set! design " << *propit << " 0.0)"; temp = scheme_eval_string(formater.str().c_str(), env); } std::map<uint32_t, std::map<uint32_t, std::list<std::string> > > propranking; for(IdMap::iterator compit = complist.begin(); compit != complist.end(); ++compit){ Component::Ptr c = ds->getComponent(compit->first); std::map<uint32_t, std::string> pilist = c->getPropertyList(); for(std::map<uint32_t, std::string>::iterator piit = pilist.begin(); piit != pilist.end(); ++piit){ Property::Ptr p = ds->getProperty(piit->first); for(uint32_t i = 0; i < compit->second; i++){ propranking[p->getRank()][p->getPropertyId()].push_back(piit->second); } } } std::map<uint32_t, PropertyValue> propertyvalues; for(std::map<uint32_t, std::map<uint32_t, std::list<std::string> > >::iterator rpiit = propranking.begin(); rpiit != propranking.end(); ++rpiit){ std::map<uint32_t, std::list<std::string> > pilist = rpiit->second; std::set<PropertyValue> localvalues; for(std::map<uint32_t, std::list<std::string> >::iterator piit = pilist.begin(); piit != pilist.end(); ++piit){ PropertyValue propval(piit->first,0.0); std::list<double> listvals; std::list<std::string> lambdas = piit->second; for(std::list<std::string>::iterator itlamb = lambdas.begin(); itlamb != lambdas.end(); ++itlamb){ temp = scheme_eval_string((std::string("(") + (*itlamb) + " design)").c_str(), env); if(!SCHEME_NUMBERP(temp)){ Logger::getLogger()->warning("MzScheme: Return not a number"); }else{ listvals.push_back(scheme_real_to_double(temp)); } } Property::Ptr p = ds->getProperty(piit->first); formater.str(""); formater << "(" << p->getTpclDisplayFunction() << " design '("; for(std::list<double>::iterator itvals = listvals.begin(); itvals != listvals.end(); ++itvals){ formater << *itvals << " "; } formater << "))"; temp = scheme_eval_string(formater.str().c_str(), env); #ifdef HAVE_MZSCHEME20X if(!SCHEME_PAIRP(temp) || !SCHEME_NUMBERP(SCHEME_CAR(temp)) || !SCHEME_STRINGP(SCHEME_CDR(temp))){ #else if(!SCHEME_PAIRP(temp) || !SCHEME_NUMBERP(SCHEME_CAR(temp)) || !SCHEME_CHAR_STRINGP(SCHEME_CDR(temp))){ #endif Logger::getLogger()->warning("MzScheme: Return not a pair, or the wrong time in the pair"); }else{ propval.setValue(scheme_real_to_double(SCHEME_CAR(temp))); #ifdef HAVE_MZSCHEME20X propval.setDisplayString(std::string(SCHEME_STR_VAL(SCHEME_CDR(temp)))); #else propval.setDisplayString(std::string((char*)SCHEME_CHAR_STR_VAL(SCHEME_CDR(temp)))); #endif localvalues.insert(propval); } } for(std::set<PropertyValue>::iterator pvit = localvalues.begin(); pvit != localvalues.end(); ++pvit){ PropertyValue pv = *pvit; formater.str(""); formater << "(property-designType-set! design " << pv.getPropertyId() << " " << pv.getValue() << ")"; temp = scheme_eval_string(formater.str().c_str(), env); propertyvalues[pv.getPropertyId()] = pv; } } d->setPropertyValues(propertyvalues); // now check if the design is valid bool valid = true; std::string feedback = ""; Logger::getLogger()->debug("About to process requirement functions"); for(IdMap::iterator compit = complist.begin(); compit != complist.end(); ++compit){ uint32_t curval = compit->first; //for each component in the design temp = scheme_eval_string((std::string("(") + ds->getComponent(curval)->getTpclRequirementsFunction() + " design)").c_str(), env); #ifdef HAVE_MZSCHEME20X if(!SCHEME_PAIRP(temp) || !SCHEME_STRINGP(SCHEME_CDR(temp))){ #else if(!SCHEME_PAIRP(temp) || !SCHEME_CHAR_STRINGP(SCHEME_CDR(temp))){ #endif Logger::getLogger()->warning("MzScheme: (a) Return not a pair, or the wrong time in the pair"); }else{ valid &= SCHEME_TRUEP(SCHEME_CAR(temp)); #ifdef HAVE_MZSCHEME20X std::string strtemp = SCHEME_STR_VAL(SCHEME_CDR(temp)); #else std::string strtemp = (char*)SCHEME_CHAR_STR_VAL(SCHEME_CDR(temp)); #endif if(strtemp.length() > 0) feedback += strtemp + " "; } } for(std::map<uint32_t, std::map<uint32_t, std::list<std::string> > >::iterator rpiit = propranking.begin(); rpiit != propranking.end(); ++rpiit){ std::map<uint32_t, std::list<std::string> > pilist = rpiit->second; for(std::map<uint32_t, std::list<std::string> >::iterator piit = pilist.begin(); piit != pilist.end(); ++piit){ temp = scheme_eval_string((std::string("(") + ds->getProperty(piit->first)->getTpclRequirementsFunction() + " design)").c_str(), env); #ifdef HAVE_MZSCHEME20X if(!SCHEME_PAIRP(temp) || !SCHEME_STRINGP(SCHEME_CDR(temp))){ #else if(!SCHEME_PAIRP(temp) || !SCHEME_CHAR_STRINGP(SCHEME_CDR(temp))){ #endif Logger::getLogger()->warning("MzScheme: (a) Return not a pair, or the wrong time in the pair"); }else{ valid &= SCHEME_TRUEP(SCHEME_CAR(temp)); #ifdef HAVE_MZSCHEME20X std::string strtemp = SCHEME_STR_VAL(SCHEME_CDR(temp)); #else std::string strtemp = (char*)SCHEME_CHAR_STR_VAL(SCHEME_CDR(temp)); #endif if(strtemp.length() > 0) feedback += strtemp + " "; } } } propranking.clear(); d->setValid(valid, feedback); Logger::getLogger()->debug("Eval'ed design"); if(!valid){ Logger::getLogger()->debug("Design %s is not valid, reason: %s", d->getName().c_str(), feedback.c_str()); } } } TpMzScheme::TpMzScheme(){ //scheme_set_stack_base(NULL, 1); /* required for OS X, only. WILL NOT WORK HERE */ bool loaded = false; env = scheme_basic_env(); if (scheme_setjmp(scheme_error_buf)) { Logger::getLogger()->warning("MzScheme warning: could not load local file, trying installed file"); } else { scheme_eval_string("(load \"../modules/tpcl/mzscheme/designstruct.scm\")",env); loaded = true; } if(loaded == false){ if (scheme_setjmp(scheme_error_buf)) { Logger::getLogger()->warning("MzScheme warning: could not load installed file"); } else { scheme_eval_string("(load \"" DATADIR "/tpserver/tpscheme/mzscheme/designstruct.scm\")", env); loaded = true; } } if(loaded == false){ Logger::getLogger()->error("MzScheme Error: failed to load designstruct.scm file"); //throw exception? } }