自学教程：C++ BODY函数代码示例

short PEXPORT Kpp__SetupRule(LPRULE lpRule, LISTID idVarList,                             LISTID idClassList, EXPID idIfPart,                             EXPID idThenPart){#ifdef INFERENCE    PRIORITY(lpRule) = 0;    MATCHES(lpRule) = NULLID;    NUMVARS(lpRule) = KppListLen(idVarList);    BODY(lpRule) = JoinIfThen(idIfPart, idThenPart);    if (idIfPart)        KppDeleteExp(idIfPart);    if (idThenPart)        KppDeleteExp(idThenPart);    if (NUMVARS(lpRule) == 0)        VARS(lpRule) = KppMakeList(0);    else    {        VARS(lpRule) = MakeRuleArgList(idVarList, idClassList);        if (idVarList)            KppDeleteList(idVarList);        if (idClassList)            KppDeleteList(idClassList);        idVarList = VARS(lpRule);        KppClearVarList(idVarList);        KppBindVars(idVarList, BODY(lpRule));        }#endif   return TRUE;}

RULEID __CopyRule(LPRULE lpOldRule, ITEMID idName){#ifdef INFERENCE    RULEID      idRule;    LPRULE      lpRule;    LPEXP       lpBody;    EXPID       idBody;    if (GetRule(idName) != NULLID)        return NULLID;        idRule = KppAddItemAndName (RULE, (LPLPSTR)&lpRule, idName);    if (!idRule)        return NULLID;    NAME(lpRule) = idName;    FLAGS(lpRule) = NULL;    PRIORITY(lpRule) = 0;    MATCHES(lpRule) = NULLID;    NUMVARS(lpRule) = NUMVARS(lpOldRule);    if (! (FLAGS(lpRule) & CBODY))    {        VARS(lpRule) = KppDeepListCopy(VARS(lpOldRule), Kpp__CopyVar,idRule);        idBody = BODY(lpRule) = KppCopyExp(                        BODY(lpOldRule), (LPLPSTR)&lpBody, kPERMMODE);        KppReleaseExp(idBody);    }    KppReleaseItem(RULE, idRule);    /* Add to KnowledgeTools */    KppAddItemCB (RULE, 1);    return idRule;#endif}

static VALUE rb_cpApplyDampedSpring(VALUE klass, VALUE a, VALUE b,   VALUE anchr1, VALUE anchr2, VALUE rlen, VALUE k, VALUE dmp, VALUE dt){  cpApplyDampedSpring(BODY(a), BODY(b), *VGET(anchr1), *VGET(anchr2),   NUM2DBL(rlen), NUM2DBL(k), NUM2DBL(dmp), NUM2DBL(dt));  return klass;} 

short PEXPORT Kpp__ResetGoal(LPGOAL lpGoal){#ifdef INFERENCE    /* delete the goal body */    if (! (FLAGS(lpGoal) & CBODY)        && BODY(lpGoal) != NULLID)        KppDeleteExp(BODY(lpGoal));#endif    return TRUE;}

static VALUErb_cpBodyInitialize(VALUE self, VALUE m, VALUE i) {  cpBody *body = BODY(self);  cpBodyInit(body, NUM2DBL(m), NUM2DBL(i));  body->data = (void *)self;  return self;}

SEXP attribute_hidden do_bodyCode(SEXP call, SEXP op, SEXP args, SEXP rho){    checkArity(op, args);    if (TYPEOF(CAR(args)) == CLOSXP)	return duplicate(BODY(CAR(args)));    else return R_NilValue;}

SEXP attribute_hidden do_envirgets(SEXP call, SEXP op, SEXP args, SEXP rho){    SEXP env, s = CAR(args);    checkArity(op, args);    check1arg(args, call, "x");    env = CADR(args);    if (TYPEOF(CAR(args)) == CLOSXP	&& (isEnvironment(env) ||	    isEnvironment(env = simple_as_environment(env)) ||	    isNull(env))) {	if (isNull(env))	    error(_("use of NULL environment is defunct"));	if(MAYBE_SHARED(s))	    /* this copies but does not duplicate args or code */	    s = duplicate(s);	if (TYPEOF(BODY(s)) == BCODESXP)	    /* switch to interpreted version if compiled */	    SET_BODY(s, R_ClosureExpr(CAR(args)));	SET_CLOENV(s, env);    }    else if (isNull(env) || isEnvironment(env) ||	isEnvironment(env = simple_as_environment(env)))	setAttrib(s, R_DotEnvSymbol, env);    else	error(_("replacement object is not an environment"));    return s;}

WORD __EvalFunc(LPFUNC lpFunc, LISTID idArgList){    WORD i = FALSE;    ATOMID idName = NAME(lpFunc);    EXPID idBody;    LPEXP lpBody;    LISTID idVarList;    GLOBALHANDLE hBody;    if (NUMVARS(lpFunc) != KppListLen(idArgList))        return KppRegisterKappaMessage(hResThisDll, IDE_BADNUMARG,                                        idName, NULLID, NULLID);    idVarList = VARS(lpFunc);    idBody = BODY(lpFunc);    if (!idBody)        KappaReturnAtom(lpIDs->idNull);    UnwindProtect(cleanup);    if (lpKALView && lpKALView->bActive)        (*lpKALView->PushFn)(idName);    lpBody = KppCopyTempExp(idBody, (GLOBALHANDLE FAR *) &hBody);    Kpp__LoadArgs(lpBody, idVarList, idArgList);        i = Kpp_EvalExp(lpBody);  cleanup:    KppReleaseTempExp(hBody, i);    KppUnbindVars(idVarList);    if (lpKALView && lpKALView->bActive)        (*lpKALView->Pop)(TRUE);    EndProtect();        return i;}

static VALUErb_cpShapeSetBody(VALUE self, VALUE body){	SHAPE(self)->body = BODY(body);	rb_ivar_set(self, id_body, body);		return body;}

static VALUErb_cpBodyIsStatic(VALUE self) {  cpBody * body = BODY(self);  cpBool stat   = 0;  // cpBodyInitStatic(body);  stat = cpBodyIsStatic(body);  return stat ? Qtrue : Qfalse;  //}

/* generatePlummer: generate Plummer model initial conditions for test * runs, scaled to units such that M = -4E = G = 1 (Henon, Heggie, * etc).  See Aarseth, SJ, Henon, M, & Wielen, R (1974) Astr & Ap, 37, * 183. */static int nbGenerateIsotropicCore(lua_State* luaSt,				   dsfmt_t* prng,				   unsigned int nbody,				   real mass1,				   real mass2,				   mwbool ignore,				   				   mwvector rShift,				   mwvector vShift,				   real radiusScale1,				   real radiusScale2){    unsigned int i;    int table;    Body b;    real r, velScale;    real mass = mass1 + mass2;    real radiusScale = mw_sqrt(mw_pow(radiusScale1,2) + mw_pow(radiusScale2,2));    memset(&b, 0, sizeof(b));    velScale =  mw_sqrt(mass / radiusScale);     /* and recip. speed scale */    b.bodynode.type = BODY(ignore);    /* Same for all in the model */    b.bodynode.mass = mass / nbody;    /* Mass per particle */    lua_createtable(luaSt, nbody, 0);    table = lua_gettop(luaSt);        for (i = 0; i < nbody; ++i)    {        do        {	  r = isotropicRandomR(prng, radiusScale1, radiusScale2, mass1, mass2);	    /* FIXME: We should avoid the divide by 0.0 by multiplying             * the original random number by 0.9999.. but I'm too lazy             * to change the tests. Same with other models */        }        while (isinf(r));        b.bodynode.pos = isotropicBodyPosition(prng, rShift, r);        b.vel = isotropicBodyVelocity(prng, r, vShift, velScale, radiusScale1, radiusScale2, mass1, mass2);	        assert(nbPositionValid(b.bodynode.pos));        pushBody(luaSt, &b);	//	printf("Body %d is pushed. /n",i);        lua_rawseti(luaSt, table, i + 1);    }    return 1;}

static VALUErb_cpCircleInitialize(VALUE self, VALUE body, VALUE radius, VALUE offset){	cpCircleShape *circle = (cpCircleShape *)SHAPE(self);		cpCircleShapeInit(circle, BODY(body), NUM2DBL(radius), *VGET(offset));	circle->shape.data = (void *)self;	circle->shape.collision_type = Qnil;	rb_ivar_set(self, id_body, body);		return self;}

static VALUErb_cpSegmentInitialize(VALUE self, VALUE body, VALUE a, VALUE b, VALUE r){	cpSegmentShape *seg = (cpSegmentShape *)SHAPE(self);		cpSegmentShapeInit(seg, BODY(body), *VGET(a), *VGET(b), NUM2DBL(r));	seg->shape.data = (void *)self;	seg->shape.collision_type = Qnil;	rb_ivar_set(self, id_body, body);		return self;}

obj_t * apply(obj_t *args, obj_t *env) {	assert(IS_LIST(args));	if (IS_LIST(CAR(args)) && IS_FUNC(CAR(CAR(args)))) {		return (FUNC(CAR(CAR(args))))(CDR(args), env);	} else if (IS_LIST(CAR(args)) && IS_DEFUNC(CAR(CAR(args)))) {		obj_t * func_args;		obj_t * call_args;		obj_t * body;		obj_t * result;		body = clone_obj(BODY(CAR(CAR(args))));		func_args = ARGS(CAR(CAR(args)));		call_args = CDR(args);		/* ((<DEFUNC:[args=(X)][body=(TIMES X X)]>) 3) */		while (IS_LIST(func_args) && IS_LIST(call_args)) {			obj_t * func_arg = CAR(func_args);			obj_t * call_arg = CAR(call_args);			replace_obj(func_arg, call_arg, body);			func_args = CDR(func_args);			call_args = CDR(call_args);		}		if ((IS_LIST(func_args) && !IS_LIST(call_args)) ||				(!IS_LIST(func_args) && IS_LIST(call_args))) {			free_obj(body); /* clean up */			fprintf(stdout, "Unexpected number of arguments/n");			return alloc_fail();		}		result = eval(body, env);		free_obj(body);		return result;	} else {		return clone_obj(args);	}}

SEXP reassign_function(SEXP name, SEXP env, SEXP old_fun, SEXP new_fun){  if (TYPEOF(name) != SYMSXP) error("name must be a symbol");  if (TYPEOF(env) != ENVSXP) error("env must be an environment");  if (TYPEOF(old_fun) != CLOSXP) error("old_fun must be a function");  if (TYPEOF(new_fun) != CLOSXP) error("new_fun must be a function");  SET_FORMALS(old_fun, FORMALS(new_fun));  SET_BODY(old_fun, BODY(new_fun));  SET_CLOENV(old_fun, CLOENV(new_fun));  DUPLICATE_ATTRIB(old_fun, new_fun);  return R_NilValue;}

short PEXPORT Kpp__ResetFunc(LPFUNC lpFunc){    if (! (FLAGS(lpFunc) & CBODY))    {        /* first delete the list of variables */        if (VARS(lpFunc) != NULLID)        {            KppClearVarList(VARS(lpFunc));            KppClearList(VARS(lpFunc), VAR);            KppDeleteList(VARS(lpFunc));            VARS (lpFunc) = NULLID;        }        /* then delete the body */        if (BODY(lpFunc) != NULLID)        {            KppDeleteExp(BODY(lpFunc));            BODY(lpFunc) = NULLID;        }    }        return TRUE;}

GOALID __CopyGoal(LPGOAL lpOldGoal, ITEMID idName){#ifdef INFERENCE    GOALID      idGoal;    LPGOAL      lpGoal;    LPEXP       lpBody;    EXPID       idBody;    if (GetGoal(idName) != NULLID)        return NULLID;        idGoal = KppAddItemAndName(GOAL, (LPLPSTR)&lpGoal, idName);    if (!idGoal)        return NULLID;        NAME(lpGoal) = idName;    FLAGS(lpGoal) = NULL;    PRIORITY(lpGoal) = 0;    if (! (FLAGS(lpGoal) & CBODY))    {        if (BODY(lpGoal) == NULLID)            idBody = NULLID;        else        {            idBody = BODY(lpGoal) = KppCopyExp(BODY(lpOldGoal),                                (LPLPSTR)&lpBody, kPERMMODE);            KppReleaseExp(idBody);        }    }    KppReleaseItem(GOAL, idGoal);    /* Add to KnowledgeTools */    KppAddItemCB(GOAL, 1);    return idGoal;#endif}

short PEXPORT Kpp__ResetRule(LPRULE lpRule){#ifdef INFERENCE    if (FLAGS(lpRule) & CBODY)    {        if (VARS(lpRule)) KppDeleteList(VARS(lpRule));        if (CIFPAIRS(lpRule)) KppDeleteList(CIFPAIRS(lpRule));        if (CTHENPAIRS(lpRule)) KppDeleteList(CTHENPAIRS(lpRule));    }    else    {        /* first delete the list of variables */        if (VARS(lpRule) != NULLID)        {            KppClearVarList(VARS(lpRule));            KppClearList(VARS(lpRule), VAR);            KppDeleteList(VARS(lpRule));            VARS (lpRule) = NULLID;        }        /* then delete the body */        if (BODY(lpRule) != NULLID)        {            KppDeleteExp(BODY(lpRule));            BODY(lpRule) = NULLID;        }    }        /* then delete list of matches if it exists! */    if (MATCHES(lpRule) != NULLID) {        KppDeleteMatchList(MATCHES(lpRule));        MATCHES(lpRule) = NULLID;        }#endif    return TRUE;}

FUNCID __CopyFunc(LPFUNC lpOldFunc, ITEMID idName){    FUNCID      idFunc;    LPFUNC      lpFunc;    LPEXP       lpBody;    EXPID       idBody;    if (GetFunc(idName) != NULLID)        return NULLID;        idFunc = KppAddItemAndName (FUNC, (LPLPSTR)&lpFunc, idName);    if (!idFunc)        return NULLID;    NAME(lpFunc) = idName;    FLAGS(lpFunc) = NULL;    NUMVARS(lpFunc) = NUMVARS(lpOldFunc);    if (! (FLAGS(lpFunc) & CBODY))    {        VARS(lpFunc) = KppDeepListCopy(VARS(lpOldFunc), Kpp__CopyVar, idFunc);        if (BODY(lpOldFunc) == NULLID)            idBody = NULLID;        else        {            idBody = BODY(lpFunc) = KppCopyExp(BODY(lpOldFunc),                                        (LPLPSTR)&lpBody, kPERMMODE);            KppReleaseExp(idBody);        }    }    KppReleaseItem(FUNC, idFunc);    /* Add to KnowledgeTools */    KppAddItemCB (FUNC, 1);    return idFunc;}

/* PrintLanguage() or PrintClosure() : */static void PrintLanguageEtc(SEXP s, Rboolean useSource, Rboolean isClosure){    int i;    SEXP t = getAttrib(s, R_SrcrefSymbol);    Rboolean useSrc = useSource && isInteger(t);    if (useSrc) {	PROTECT(t = lang2(R_AsCharacterSymbol, t));	t = eval(t, R_BaseEnv);	UNPROTECT(1);    } else {	t = deparse1w(s, 0, useSource | DEFAULTDEPARSE);    }    PROTECT(t);    for (i = 0; i < LENGTH(t); i++) { 	Rprintf("%s/n", translateChar(STRING_ELT(t, i))); // translate: for srcref part (PR#16732)    }    UNPROTECT(1);    if (isClosure) {	if (isByteCode(BODY(s))) Rprintf("<bytecode: %p>/n", BODY(s));	t = CLOENV(s);	if (t != R_GlobalEnv)	    Rprintf("%s/n", EncodeEnvironment(t));    }}

static VALUErb_cpBodySetPositionFunc(int argc, VALUE *argv, VALUE self) {  VALUE block;  cpBody * body = BODY(self);  rb_scan_args(argc, argv, "&", &block);  // Restore defaults if no block  if (NIL_P(block)) {    body->position_func = cpBodyUpdatePosition; //Default;    return Qnil;  }  // set block for use in callback  rb_iv_set(self, "position_func", block);  body->position_func = bodyPositionCallback;  return self;}

static VALUErb_cpBodySetVelocityFunc(int argc, VALUE *argv, VALUE self) {  VALUE block;  cpBody * body = BODY(self);  rb_scan_args(argc, argv, "0&", &block);  // Restore defaults if no block  if (NIL_P(block)) {    body->velocity_func = cpBodyUpdateVelocity; //Default;    return Qnil;  }  // set block for use in callback  rb_iv_set(self, "velocity_func", block);  body->velocity_func = bodyVelocityCallback;  return self;}

GOALID PEXPORT Kpp_MakeGoal(ITEMID idName, EXPID idBody){#ifdef INFERENCE    GOALID idGoal;    LPGOAL lpGoal;    if (!KppIsGoodAtom(idName))        return NULLID;    idGoal = Kpp_GetItem(GOAL, idName);    if (idGoal)    {        int over = KppAllowOverrideCB(GOAL, idName, idGoal, NULLID);                    if (!over)            return KppRegisterKappaMessage(hResThisDll,                                           IDE_ITEMALREADYEXISTS,                                           idName, NULLID, NULLID);        else if (over == -1)        {            bItemSkipped = TRUE;            return idGoal;        }    }    CHECK_MAX_LIMITED_VER(GOAL, idName);    idGoal = KppAddItemAndName (GOAL, (LPLPSTR)&lpGoal, idName);    if (!idGoal)        return NULLID;    NAME(lpGoal) = idName;    FLAGS(lpGoal) = NULL;    PRIORITY(lpGoal) = 0;    if (!idBody)        idBody = KppBuildNullExp();    else        KppResetBoundFlag(idBody);    BODY(lpGoal) = idBody;    KppReleaseItem(GOAL, idGoal);    /* Add to KnowledgeTools */    KppAddItemCB (GOAL, 1);    return idGoal;#endif}

static cpBody *rb_cpBodySleepValidate(VALUE vbody) {  cpBody * body  = BODY(vbody);  cpSpace *space = body->CP_PRIVATE(space);  if(!space) {    rb_raise(rb_eArgError, "Cannot put a body to sleep that has not been added to a space.");    return NULL;  }  if (cpBodyIsStatic(body) && cpBodyIsRogue(body)) {    rb_raise(rb_eArgError, "Rogue AND static bodies cannot be put to sleep.");    return NULL;  }  if(cpSpaceIsLocked(space)) {    rb_raise(rb_eArgError, "Bodies can not be put to sleep during a query or a call to Space#add_collision_func. Put these calls into a post-step callback using Space#add_collision_handler.");    return NULL;  }  return body;}

static VALUErb_cpPolyInitialize(VALUE self, VALUE body, VALUE arr, VALUE offset){	cpPolyShape *poly = (cpPolyShape *)SHAPE(self);		Check_Type(arr, T_ARRAY);	int numVerts = RARRAY_LEN(arr);	VALUE *ary_ptr = RARRAY_PTR(arr);	cpVect verts[numVerts];		for(int i=0; i<numVerts; i++)		verts[i] = *VGET(ary_ptr[i]);		cpPolyShapeInit(poly, BODY(body), numVerts, verts, *VGET(offset));	poly->shape.data = (void *)self;	poly->shape.collision_type = Qnil;	rb_ivar_set(self, id_body, body);		return self;}

WORD PEXPORT KppTestGoal(ITEMID idGoal){#ifdef INFERENCE    WORD i = FALSE;    EXPID idBody;    LPEXP lpBody2;    LPGOAL lpGoal = (LPGOAL) KppGetItem(GOAL, idGoal);    GLOBALHANDLE hBody2;    LOGICALID (EXPORT FAR *pBody)(void);    if (!lpGoal)        return KppRegisterKappaMessage (hResThisDll,             IDE_ERRORINFUNC, lpIDs->idError, NULLID, NULLID);    if (FLAGS(lpGoal) & CBODY)    {        pBody = CBODYPTR(lpGoal);        KppReleaseItem(GOAL, idGoal);        if ( !pBody )            return KppRegisterKappaMessage (hResThisDll,                 IDE_ERRORINFUNC, lpIDs->idError, NULLID, NULLID);        KappaReturnAtom( pBody() );    }    else    {        idBody = BODY(lpGoal);        KppReleaseItem(GOAL, idGoal);        if (!idBody)            KappaReturnAtom(lpIDs->idNull);        lpBody2 = KppCopyTempExp(idBody, (GLOBALHANDLE FAR *)&hBody2);        UnwindProtect (cleanup);        i = Kpp_EvalExp(lpBody2);      cleanup:        KppReleaseTempExp(hBody2, i);        EndProtect();        return i;    }#endif}

WORD _EvalFunc(ITEMID idFunc, LPEXP lpArgList, WORD nArg){    LPFUNC lpFunc = (LPFUNC) KppGetItem(FUNC, idFunc);    WORD i = FALSE;    ATOMID idName;    EXPID idBody;    LPEXP lpBody;    LISTID idVarList;    GLOBALHANDLE hBody;    if (!lpFunc)        return KppRegisterKappaMessage(hResThisDll, IDE_ERRORINFUNC,                                       lpIDs->idError, NULLID, NULLID);    if (NUMVARS(lpFunc) != nArg)    {        idName = NAME(lpFunc);        KppReleaseItem(FUNC, idFunc);        return KppRegisterKappaMessage(hResThisDll, IDE_BADNUMARG,                                       idName, NULLID, NULLID);    }    idVarList = VARS(lpFunc);    idBody = BODY(lpFunc);    KppReleaseItem(FUNC, idFunc);    if (idBody == NULLID)        KappaReturnAtom(lpIDs->idNull);    lpBody = KppCopyTempExp(idBody, (GLOBALHANDLE FAR *)&hBody);    Kpp___LoadArgs(lpBody, idVarList, lpArgList);    UnwindProtect (cleanup);    i = Kpp_EvalExp(lpBody);  cleanup:    KppReleaseTempExp (hBody, i);    KppUnbindVars(idVarList);    EndProtect();    return i;}

/* * This actually does the interpolation, using the coefficients * computed by sInterp().  Uses shares at offset byteNumber within the * bodies. * The Lagrange values come from the headers of the "shares" array. */	static PGPBytesDoInterp(PGPByte *shares, PGPSize bodySize, PGPUInt32 nShares,	PGPUInt32 byteNumber){	PGPByte x, y;	PGPByte lagrange;	PGPUInt32 i;	x = 0;	for( i=0; i < nShares; ++i )	{		y = BODY(shares, bodySize, i)[byteNumber];		if (y != 0)		{			lagrange = HEADER(shares, bodySize, i)->lagrange;			y = f_exp[lagrange + f_log[y]];		}		x = f_add(x,y);	}	return x;}

short PEXPORT Kpp__SetupFunc(LPFUNC lpFunc, LISTID idAtomList, EXPID idBody){    LISTID idVarList = KppMakeList(0);    if (idAtomList && idAtomList != lpIDs->idNull)    {        LIST_LOOP loop;        ATOMID idItem;                kpc_init_loop(idAtomList, &loop);        while (idItem = KppNextListElement(&loop)) {            LPVAR lpVar;            VARID idVar = KppAddItem(VAR, (LPLPSTR) &lpVar);                        VARNAME(lpVar) = idItem;            BINDINGS(lpVar) = NULLID;            VARCLASS(lpVar) = NULLID;            VARPREV(lpVar) = NULLID;            KppReleaseItem(VAR, idVar);            KppAppendElem(idVarList, idVar);        }    }    KppDeleteList(idAtomList);    NUMVARS(lpFunc) = KppListLen(idVarList);    if (!idBody)        idBody = KppBuildNullExp();    else        KppResetBoundFlag(idBody);    BODY(lpFunc) = idBody;    VARS(lpFunc) = idVarList;    if (NUMVARS(lpFunc))    {        KppClearVarList(idVarList);        KppBindVars(idVarList, idBody);    }        return TRUE;}

static VALUErb_dampedSpring(VALUE self, VALUE a, VALUE b, VALUE r1, VALUE r2, VALUE len, VALUE k, VALUE dmp, VALUE dt){	cpDampedSpring(BODY(a), BODY(b), *VGET(r1), *VGET(r2), NUM2DBL(len), NUM2DBL(k), NUM2DBL(dmp), NUM2DBL(dt));	return Qnil;}